home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Source Code / C / Games / Xconq 7.1.0 / src / xconq-7.1.0 / kernel / read.c < prev    next >
Encoding:
C/C++ Source or Header  |  1996-07-07  |  101.4 KB  |  4,016 lines  |  [TEXT/R*ch]
  1. /* Interpretation of Xconq GDL.
  2.    Copyright (C) 1989, 1991, 1992, 1993, 1994, 1995, 1996 Stanley T. Shebs.
  3.  
  4. Xconq is free software; you can redistribute it and/or modify
  5. it under the terms of the GNU General Public License as published by
  6. the Free Software Foundation; either version 2, or (at your option)
  7. any later version.  See the file COPYING.  */
  8.  
  9. /* Syntax is el cheapo Lisp. */
  10.  
  11. #include "conq.h"
  12. #define for_both_lists(lis1,lis2,rest1,rest2)  \
  13.    for (rest1 = (lis1), rest2 = (lis2);  \
  14.     rest1 != lispnil && rest2 != lispnil;  \
  15.     rest1 = cdr(rest1), rest2 = cdr(rest2))
  16. #include "imf.h"
  17.  
  18. extern int actually_read_lisp;
  19.  
  20. static void module_and_line PARAMS ((Module *module, char *buf));
  21. static void init_constant PARAMS ((int key, int val));
  22. static void init_self_eval PARAMS ((int key));
  23. static void useless_form_warning PARAMS ((Module *module, Obj *form));
  24. static void include_module PARAMS ((Obj *form, Module *module));
  25. static void start_conditional PARAMS ((Obj *form, Module *module));
  26. static void start_else PARAMS ((Obj *form, Module *module));
  27. static void end_conditional PARAMS ((Obj *form, Module *module));
  28. static Variant *interp_variant_defns PARAMS ((Obj *lis));
  29. static void interp_utype PARAMS ((Obj *form));
  30. static void fill_in_utype PARAMS ((int u, Obj *list));
  31. static int set_utype_property PARAMS ((int u, char *propname, Obj *val));
  32. static void interp_mtype PARAMS ((Obj *form));
  33. static void fill_in_mtype PARAMS ((int m, Obj *list));
  34. static void interp_ttype PARAMS ((Obj *form));
  35. static void fill_in_ttype PARAMS ((int t, Obj *list));
  36. static void interp_table PARAMS ((Obj *form));
  37. static void add_to_table PARAMS ((Obj *tablename, int tbl, Obj *clauses));
  38. static void interp_one_clause PARAMS ((Obj *tablename, int tbl, int lim1, int lim2, Obj *indexes1, Obj *indexes2, Obj *values));
  39. static void interp_variable PARAMS ((Obj *form, int isnew));
  40. static void undefine_variable PARAMS ((Obj *form));
  41. static void add_properties PARAMS ((Obj *form));
  42. static int list_lengths_match PARAMS ((Obj *types, Obj *values, char *formtype, Obj *form));
  43. static void add_to_utypes PARAMS ((Obj *types, Obj *prop, Obj *values));
  44. static void add_to_mtypes PARAMS ((Obj *types, Obj *prop, Obj *values));
  45. static void add_to_ttypes PARAMS ((Obj *types, Obj *prop, Obj *values));
  46. static void interp_world PARAMS ((Obj *form));
  47. static void interp_area PARAMS ((Obj *form));
  48. static void fill_in_terrain PARAMS ((Obj *contents));
  49. static void fill_in_aux_terrain PARAMS ((Obj *contents));
  50. static void fill_in_people_sides PARAMS ((Obj *contents));
  51. static void fill_in_features PARAMS ((Obj *contents));
  52. static void fill_in_elevations PARAMS ((Obj *contents));
  53. static void fill_in_cell_material PARAMS ((Obj *contents));
  54. static void fill_in_temperatures PARAMS ((Obj *contents));
  55. static void fill_in_winds PARAMS ((Obj *contents));
  56. static void fill_in_clouds PARAMS ((Obj *contents));
  57. static void fill_in_cloud_bottoms PARAMS ((Obj *contents));
  58. static void fill_in_cloud_heights PARAMS ((Obj *contents));
  59. static void interp_side PARAMS ((Obj *form, Side *side));
  60. static void check_name_uniqueness PARAMS ((Side *side, char *str, char *kind));
  61. static void merge_unit_namers PARAMS ((Side *side, Obj *lis));
  62. static void interp_side_value_list PARAMS ((short *arr, Obj *lis));
  63. static void interp_atkstats_list PARAMS ((Side *side, Obj *lis));
  64. static void interp_hitstats_list PARAMS ((Side *side, Obj *lis));
  65. static void fn_set_terrain_view PARAMS ((int x, int y, int val));
  66. static void fn_set_aux_terrain_view PARAMS ((int x, int y, int val));
  67. static void fn_set_terrain_view_date PARAMS ((int x, int y, int val));
  68. static void fn_set_aux_terrain_view_date PARAMS ((int x, int y, int val));
  69. static void fn_set_unit_view PARAMS ((int x, int y, int val));
  70. static void fn_set_unit_view_date PARAMS ((int x, int y, int val));
  71. static void fn_set_material_view PARAMS ((int x, int y, int val));
  72. static void fn_set_material_view_date PARAMS ((int x, int y, int val));
  73. static void fn_set_temp_view PARAMS ((int x, int y, int val));
  74. static void fn_set_temp_view_date PARAMS ((int x, int y, int val));
  75. static void fn_set_cloud_view PARAMS ((int x, int y, int val));
  76. static void fn_set_cloud_bottom_view PARAMS ((int x, int y, int val));
  77. static void fn_set_cloud_height_view PARAMS ((int x, int y, int val));
  78. static void fn_set_cloud_view_date PARAMS ((int x, int y, int val));
  79. static void fn_set_wind_view PARAMS ((int x, int y, int val));
  80. static void fn_set_wind_view_date PARAMS ((int x, int y, int val));
  81. static void read_view_layer PARAMS ((Side *side, Obj *contents, void (*setter)(int, int, int)));
  82. static void read_aux_terrain_view_layer PARAMS ((Side *side, Obj *contents, void (*setter)(int, int, int)));
  83. static void read_material_view_layer PARAMS ((Side *side, Obj *contents, void (*setter)(int, int, int)));
  84. static void read_general_doctrine PARAMS ((Side *side, Obj *props));
  85. static void read_utype_doctrine PARAMS ((Side *side, Obj *list));
  86. static void interp_doctrine PARAMS ((Obj *form));
  87. static void fill_in_doctrine PARAMS ((struct a_doctrine *doctrine, Obj *props));
  88. static void interp_player PARAMS ((Obj *form));
  89. static void fill_in_player PARAMS ((struct a_player *player, Obj *props));
  90. static void interp_agreement PARAMS ((Obj *form));
  91. static void interp_unit_defaults PARAMS ((Obj *form));
  92. static void interp_unit PARAMS ((Obj *form));
  93. static void interp_utype_list PARAMS ((short *arr, Obj *lis));
  94. static void interp_utype_value_list PARAMS ((short *arr, Obj *lis));
  95. static void interp_mtype_value_list PARAMS ((short *arr, Obj *lis));
  96. static void interp_short_array PARAMS ((short *arr, Obj *lis, int n));
  97. static void interp_long_array PARAMS ((long *arr, Obj *lis, int n));
  98. static void interp_unit_act PARAMS ((Unit *unit, Obj *props));
  99. static void interp_unit_plan PARAMS ((Unit *unit, Obj *props));
  100. static Task *interp_task PARAMS ((Obj *form));
  101. static Goal *interp_goal PARAMS ((Obj *form));
  102. static void interp_namer PARAMS ((Obj *form));
  103. static void interp_text_generator PARAMS ((Obj *form));
  104. static void interp_scorekeeper PARAMS ((Obj *form));
  105. static void interp_history PARAMS ((Obj *form));
  106. static void interp_past_unit PARAMS ((Obj *form));
  107.  
  108. static void too_many_types PARAMS ((char *typename, int maxnum, Obj *name));
  109. static void unknown_property PARAMS ((char *type, char *inst, char *name));
  110. static void read_layer PARAMS ((Obj *contents, void (*setter)(int, int, int)));
  111. static void read_rle PARAMS ((Obj *contents, void (*setter)(int, int, int), short *chartable));
  112.  
  113. /* This is the module from which forms are being read and
  114.    interpreted, if they are coming from a module. */
  115.  
  116. Module *curmodule;
  117.  
  118. Obj *cond_read_stack;
  119.  
  120. /* True if game will start up in the middle of a turn. */
  121.  
  122. int midturnrestore = FALSE;
  123.  
  124. /* The count of cells that did not have valid terrain data. */
  125.  
  126. int numbadterrain = 0;
  127.  
  128. /* True if should warn about bad terrain. */
  129.  
  130. int warnbadterrain = TRUE;
  131.  
  132. char *readerrbuf;
  133.  
  134. /* This is the list of side defaults that will be applied
  135.    to all sides read subsequently. */
  136.  
  137. Obj *side_defaults;
  138.  
  139. /* Defaults to use for filling in unit properties. */
  140.  
  141. int uxoffset = 0, uyoffset = 0;
  142.  
  143. static short default_unit_side_number = -1;
  144.  
  145. static short default_unit_origside_number = -1;
  146.  
  147. static short default_unit_cp = -1;
  148.  
  149. static short default_unit_hp = -1;
  150.  
  151. static short default_unit_cxp = -1;
  152.  
  153. static short default_unit_z = -1;
  154.  
  155. static short default_transport_id = -1;
  156.  
  157. static Obj *default_unit_hook;
  158.  
  159. static short *default_supply;
  160.  
  161. static short *default_tooling;
  162.  
  163. /* Globals used to communicate with the RLE reader. */
  164.  
  165. short layer_use_default;
  166. int layer_default;
  167. int layer_multiplier;
  168. int layer_adder;
  169. short layer_area_x, layer_area_y;
  170. short layer_area_w, layer_area_h;
  171.  
  172. int ignore_specials;
  173.  
  174. /* This is the table of keywords. */
  175.  
  176. struct a_key {
  177.     char *name;
  178.     short key;
  179. } keywordtable[] = {
  180.  
  181. #undef  DEF_KWD
  182. #define DEF_KWD(NAME,CODE)  { NAME, CODE },
  183.  
  184. #include "keyword.def"
  185.  
  186.     { NULL, 0 }
  187. };
  188.  
  189. /* Given a string, return the enum of the matching keyword,
  190.    if found, else -1. */
  191.  
  192. int
  193. keyword_code(str)
  194. char *str;
  195. {
  196.     int i;
  197.  
  198.     /* (should do a binary search first, then switch to exhaustive) */
  199.     for (i = 0; keywordtable[i].name != NULL; ++i) {
  200.     if (strcmp(str, keywordtable[i].name) == 0)
  201.       return keywordtable[i].key;
  202.     }
  203.     return (-1);
  204. }
  205.  
  206. char *
  207. keyword_name(k)
  208. enum keywords k;
  209. {
  210.     return keywordtable[k].name;
  211. }
  212.  
  213. #define TYPEPROP(TYPES, N, DEFNS, I, TYPE)  \
  214.   ((TYPE *) &(((char *) (&(TYPES[N])))[DEFNS[I].offset]))[0]
  215.  
  216. /* This is a generic syntax check and escape. */
  217.  
  218. #define SYNTAX(X,TEST,MSG)  \
  219.   if (!(TEST)) {  \
  220.       syntax_error((X), (MSG));  \
  221.       return;  \
  222.   }
  223.   
  224. #define SYNTAX_RETURN(X,TEST,MSG,RET)  \
  225.   if (!(TEST)) {  \
  226.       syntax_error((X), (MSG));  \
  227.       return (RET);  \
  228.   }
  229.  
  230. void  
  231. syntax_error(x, msg)
  232. Obj *x;
  233. char *msg;
  234. {
  235.     sprintlisp(readerrbuf, x);
  236.     read_warning("syntax error in `%s' - %s", readerrbuf, msg);
  237. }
  238.  
  239. /* This is specifically for typechecking. */
  240.  
  241. #define TYPECHECK(PRED,X,MSG)  \
  242.   if (!PRED(X)) {  \
  243.       type_error((X), (MSG));  \
  244.       return;  \
  245.   }
  246.  
  247. #define TYPECHECK_RETURN(PRED,X,MSG,RET)  \
  248.   if (!PRED(X)) {  \
  249.       type_error((X), (MSG));  \
  250.       return (RET);  \
  251.   }
  252.  
  253. void
  254. type_error(x, msg)
  255. Obj *x;
  256. char *msg;
  257. {
  258.     sprintlisp(readerrbuf, x);
  259.     read_warning("type error in `%s' - %s", readerrbuf, msg);
  260. }
  261.  
  262. /* Parse the (propertyname value) lists that most forms use. */
  263.  
  264. #define PARSE_PROPERTY(BDG,NAME,VAL)  \
  265.   SYNTAX(BDG, (consp(BDG) && symbolp(car(BDG))), "property binding");  \
  266.   (NAME) = c_string(car(BDG));  \
  267.   (VAL) = cadr(BDG);
  268.  
  269. static void
  270. module_and_line(module, buf)
  271. Module *module;
  272. char *buf;
  273. {
  274.     if (module) {
  275.     if (module->startlineno != module->endlineno) {
  276.         sprintf(buf, "%s:%d-%d: ",
  277.             module->name, module->startlineno, module->endlineno);
  278.     } else {
  279.         sprintf(buf, "%s:%d: ",
  280.             module->name, module->startlineno);
  281.     }
  282.     } else {
  283.     buf[0] = '\0';
  284.     }
  285. }
  286.  
  287. static void
  288. init_constant(key, val)
  289. int key;
  290. {
  291.     Obj *sym = intern_symbol(keyword_name(key));
  292.  
  293.     setq(sym, new_number(val));
  294.     flag_as_constant(sym);
  295. }
  296.  
  297. static void
  298. init_self_eval(key)
  299. int key;
  300. {
  301.     Obj *sym = intern_symbol(keyword_name(key));
  302.  
  303.     setq(sym, sym);
  304.     flag_as_constant(sym);
  305. }
  306.  
  307. void
  308. init_predefined_symbols()
  309. {
  310.     int m;
  311.  
  312.     /* Predefined constants. */
  313.     init_constant(K_FALSE, 0);
  314.     init_constant(K_TRUE, 1);
  315.     init_constant(K_NON_UNIT, -1);
  316.     init_constant(K_NON_MATERIAL, -1);
  317.     init_constant(K_NON_TERRAIN, -1);
  318.     init_constant(K_CELL, 0);
  319.     init_constant(K_BORDER, 1);
  320.     init_constant(K_CONNECTION, 2);
  321.     init_constant(K_COATING, 3);
  322.     init_constant(K_RIVER_X, 10);
  323.     init_constant(K_VALLEY_X, 11);
  324.     init_constant(K_ROAD_X, 12);
  325.     init_constant(K_OVER_NOTHING, 0);
  326.     init_constant(K_OVER_OWN, 1);
  327.     init_constant(K_OVER_BORDER, 2);
  328.     init_constant(K_OVER_ALL, 3);
  329.     /* Random self-evaluating symbols. */
  330.     init_self_eval(K_AND);
  331.     init_self_eval(K_OR);
  332.     init_self_eval(K_NOT);
  333.     init_self_eval(K_REJECT);
  334.     init_self_eval(K_RESET);
  335.     init_self_eval(K_USUAL);
  336.     /* Leave these unbound so that first ref computes correct list. */
  337.     intern_symbol(keyword_name(K_USTAR));
  338.     intern_symbol(keyword_name(K_MSTAR));
  339.     intern_symbol(keyword_name(K_TSTAR));
  340.     /* This just needs to be inited somewhere. */
  341.     side_defaults = lispnil;
  342.     /* Same for this. */
  343.     /* (Can't use nummtypes because not set up yet.) */
  344.     if (default_supply == NULL) {
  345.     default_supply = (short *) xmalloc(MAXMTYPES * sizeof(short));
  346.     for (m = 0; m < MAXMTYPES; ++m)
  347.       default_supply[m] = -1;
  348.     }
  349.     /* And for this. */
  350.     if (readerrbuf == NULL)
  351.       readerrbuf = (char *) xmalloc(BUFSIZE);
  352. }
  353.  
  354. /* This is the basic interpreter of a form appearing in a module. */
  355.  
  356. void
  357. interp_form(module, form)
  358. Module *module;
  359. Obj *form;
  360. {
  361.     Obj *thecar;
  362.     char *name;
  363.  
  364.     /* Put the passed-in module into a global; for use in error messages. */
  365.     curmodule = module;
  366.     if (consp(form) && symbolp(thecar = car(form))) {
  367.     name = c_string(thecar);
  368.     if (Debug) {
  369.         /* If in a module, report the line number(s) of a form. */
  370.         if (module != NULL) {
  371.         Dprintf("Line %d", module->startlineno);
  372.         if (module->endlineno != module->startlineno)
  373.           Dprintf("-%d", module->endlineno);
  374.         }
  375.         Dprintf(": (%s ", name);
  376.         Dprintlisp(cadr(form));
  377.         if (cddr(form) != lispnil) {
  378.         Dprintf(" ");
  379.         Dprintlisp(caddr(form));
  380.         if (cdr(cddr(form)) != lispnil)
  381.           Dprintf(" ...");
  382.         }
  383.         Dprintf(")\n");
  384.     }
  385.     switch (keyword_code(name)) {
  386.       case K_GAME_MODULE:
  387.         interp_game_module(form, module);
  388.         load_base_module(module);
  389.         break;
  390. #ifndef SPECIAL
  391.       case K_UNIT_TYPE:
  392.         interp_utype(form);
  393.         break;
  394.       case K_MATERIAL_TYPE:
  395.         interp_mtype(form);
  396.         break;
  397.       case K_TERRAIN_TYPE:
  398.         interp_ttype(form);
  399.         break;
  400.       case K_TABLE:
  401.         interp_table(form);
  402.         break;
  403.           case K_DEFINE:
  404.         interp_variable(form, TRUE);
  405.         break;
  406.       case K_SET:
  407.         interp_variable(form, FALSE);
  408.         break;
  409.       case K_UNDEFINE:
  410.         undefine_variable(form);
  411.         break;
  412.       case K_ADD:
  413.         add_properties(form);
  414.         break;
  415. #endif /* n SPECIAL */
  416.       case K_WORLD:
  417.         interp_world(form);
  418.         break;
  419.       case K_AREA:
  420.         interp_area(form);
  421.         break;
  422.       case K_SIDE:
  423.         interp_side(form, NULL);
  424.         break;
  425.       case K_SIDE_DEFAULTS:
  426.         side_defaults = cdr(form);
  427.         break;
  428.       case K_DOCTRINE:
  429.         interp_doctrine(form);
  430.         break;
  431.       case K_INDEPENDENT_UNITS:
  432.         interp_side(form, indepside);
  433.         break;
  434.       case K_PLAYER:
  435.         interp_player(form);
  436.         break;
  437.       case K_AGREEMENT:
  438.         interp_agreement(form);
  439.         break;
  440.       case K_SCOREKEEPER:
  441.         interp_scorekeeper(form);
  442.         break;
  443.       case K_EVT:
  444.         interp_history(form);
  445.         break;
  446.       case K_EXU:
  447.         interp_past_unit(form);
  448.         break;
  449.       case K_BATTLE:
  450.         read_warning("battle objects not yet supported");
  451.         break;
  452.       case K_UNIT:
  453.         /* We must have some unit types! */
  454.         if (numutypes == 0)
  455.           load_default_game();
  456.         interp_unit(cdr(form));
  457.         break;
  458.       case K_UNIT_DEFAULTS:
  459.         interp_unit_defaults(cdr(form));
  460.         break;
  461.       case K_NAMER:
  462.         interp_namer(form);
  463.         break;
  464.       case K_TEXT:
  465.         interp_text_generator(form);
  466.         break;
  467.       case K_IMF:
  468.         interp_imf(form);
  469.         break;
  470.       case K_PALETTE:
  471.         interp_palette(form);
  472.         break;
  473.       case K_COLOR:
  474.         interp_color(form);
  475.         break;
  476.       case K_INCLUDE:
  477.         include_module(form, module);
  478.         break;
  479.       case K_IF:
  480.         start_conditional(form, module);
  481.         break;
  482.       case K_ELSE:
  483.         start_else(form, module);
  484.         break;
  485.       case K_END_IF:
  486.         end_conditional(form, module);
  487.         break;
  488.       case K_PRINT:
  489.         print_form(cadr(form));
  490.         break;
  491.       default:
  492.         if (numutypes == 0)
  493.           load_default_game();
  494.         if ((boundp(thecar) && utypep(symbol_value(thecar)))
  495.         || utype_from_name(name) != NONUTYPE) {
  496.         interp_unit(form);
  497.         } else {
  498.         useless_form_warning(module, form);
  499.         }
  500.     }
  501.     } else {
  502.     useless_form_warning(module, form);
  503.     }
  504. }
  505.  
  506. static void
  507. useless_form_warning(module, form)
  508. Module *module;
  509. Obj *form;
  510. {
  511.     char posbuf[BUFSIZE], buf[BUFSIZE];
  512.  
  513.     if (!actually_read_lisp)
  514.       return;
  515.     module_and_line(module, posbuf);
  516.     sprintlisp(buf, form);
  517.     init_warning("%sA useless form: %s", posbuf, buf);
  518. }
  519.  
  520. /* Inclusion is half-module-like, not strictly textual. */
  521.  
  522. static void
  523. include_module(form, module)
  524. Obj *form;
  525. Module *module;
  526. {
  527.     char *name;
  528.     Obj *mname = cadr(form);
  529.     Module *submodule;
  530.  
  531.     SYNTAX(mname, (symbolp(mname) || stringp(mname)),
  532.        "included module name not a string or symbol");
  533.     name = c_string(mname);
  534.     Dprintf("Including \"%s\" ...\n", name);
  535.     submodule = add_game_module(name, module);
  536.     load_game_module(submodule, TRUE);
  537.     if (submodule->loaded) {
  538.         do_module_variants(submodule, cddr(form));
  539.     } 
  540.     Dprintf("... Done including \"%s\".\n", name);
  541. }
  542.  
  543. static void
  544. start_conditional(form, module)
  545. Obj *form;
  546. Module *module;
  547. {
  548.     Obj *testform, *rslt;
  549.  
  550.     testform = cadr(form);
  551.     rslt = eval(testform);
  552.     if (numberp(rslt) && c_number(rslt) == 1) {
  553.     actually_read_lisp = TRUE;
  554.     } else {
  555.     actually_read_lisp = FALSE;
  556.     }
  557. }
  558.  
  559. static void
  560. start_else(form, module)
  561. Obj *form;
  562. Module *module;
  563. {
  564.     /* should match up with cond read stack */
  565.     actually_read_lisp = !actually_read_lisp;
  566. }
  567.  
  568. static void
  569. end_conditional(form, module)
  570. Obj *form;
  571. Module *module;
  572. {
  573.     /* should match up with cond read stack */
  574.     actually_read_lisp = TRUE;
  575. }
  576.  
  577. /* Given a list of variant-defining forms, allocate and return an
  578.    array of variant objects. */
  579.  
  580. static Variant *
  581. interp_variant_defns(lis)
  582. Obj *lis;
  583. {
  584.     int i = 0, len;
  585.     Obj *head;
  586.     Variant *varray, *var;
  587.  
  588.     if (lis == lispnil)
  589.       return NULL;
  590.     len = length(lis);
  591.     varray = (Variant *) xmalloc((len + 1) * sizeof(Variant));
  592.     for (i = 0; i < len; ++i) {
  593.     var = varray + i;
  594.     var->id = var->dflt = var->range = var->cases = lispnil;
  595.     head = car(lis);
  596.     if (symbolp(head)) {
  597.         var->id = head;
  598.         var->name = c_string(var->id);
  599.     } else if (consp(head)) {
  600.         if (stringp(car(head))) {
  601.         var->name = c_string(car(head));
  602.         head = cdr(head);
  603.         }
  604.         if (symbolp(car(head))) {
  605.         var->id = car(head);
  606.         if (var->name == NULL)
  607.           var->name = c_string(var->id);
  608.         head = cdr(head);
  609.         } else if (var->name != NULL) {
  610.             var->id = intern_symbol(var->name);
  611.         } else {
  612.         read_warning("bad variant (#%d), continuing", i);
  613.         var->id = new_number(i);
  614.         }
  615.         /* Pick up a default value if specified. */
  616.         if (!consp(car(head))) {
  617.             var->dflt = car(head);
  618.             head = cdr(head);
  619.         } else if (match_keyword(var->id, K_WORLD_SIZE)) {
  620.             var->dflt = car(head);
  621.             head = cdr(head);
  622.         } else if (match_keyword(var->id, K_REAL_TIME)) {
  623.             var->dflt = car(head);
  624.             head = cdr(head);
  625.         }
  626.         /* (should recognize and pick up a range spec if present) */
  627.         /* Case clauses are everything that's left over. */
  628.         var->cases = head;
  629.     } else {
  630.         read_warning("bad variant (#%d), ignoring", i);
  631.         var->id = new_number(i);
  632.     }
  633.     lis = cdr(lis);
  634.     }
  635.     /* Terminate the array with an id that never appears otherwise. */
  636.     varray[i].id = lispnil;
  637.     return varray;
  638. }
  639.  
  640. /* Digest the form defining the module as a whole. */
  641.  
  642. void
  643. interp_game_module(form, module)
  644. Obj *form;
  645. Module *module;
  646. {
  647.     char *name = NULL, *propname, *strval = NULL;
  648.     Obj *props = cdr(form), *bdg, *propval;
  649.  
  650.     if (module == NULL)
  651.       return;  /* why is this here? */
  652.  
  653.     /* Collect and set the module name if supplied by this form. */
  654.     if (stringp(car(props))) {
  655.     name = c_string(car(props));
  656.     props = cdr(props);
  657.     }
  658.     if (name != NULL) {
  659.     if (empty_string(module->name)) {
  660.         module->name = name;
  661.     } else {
  662.         if (strcmp(name, module->name) != 0) {
  663.         read_warning("Module name `%s' does not match declared name `%s', ignoring declared name",
  664.                  module->name, name);
  665.         }
  666.     }
  667.     }
  668.     for (; props != lispnil; props = cdr(props)) {
  669.     bdg = car(props);
  670.     PARSE_PROPERTY(bdg, propname, propval);
  671.     if (stringp(propval))
  672.       strval = c_string(propval);
  673.     switch (keyword_code(propname)) {
  674.       case K_TITLE:
  675.         module->title = strval;
  676.         break;
  677.       case K_BLURB:
  678.         module->blurb = strval;
  679.         break;
  680.       case K_PICTURE_NAME:
  681.         module->picturename = strval;
  682.         break;
  683.       case K_BASE_MODULE:
  684.         module->basemodulename = strval;
  685.         break;
  686.       case K_DEFAULT_BASE_MODULE:
  687.         module->defaultbasemodulename = strval;
  688.         break;
  689.       case K_BASE_GAME:
  690.         module->basegame = strval;
  691.         break;
  692.       case K_INSTRUCTIONS:
  693.         /* The instructions are a list of strings. */
  694.         module->instructions = propval;
  695.         break;
  696.       case K_VARIANTS:
  697.         module->variants = interp_variant_defns(cdr(bdg));
  698.         break;
  699.       case K_NOTES:
  700.         /* The player notes are a list of strings. */
  701.         module->notes = propval;
  702.         break;
  703.       case K_DESIGN_NOTES:
  704.         /* The design notes are a list of strings. */
  705.         module->designnotes = propval;
  706.         break;
  707.       case K_VERSION:
  708.         module->version = strval;
  709.         break;
  710.       case K_PROGRAM_VERSION:
  711.         module->programversion = strval;
  712.         break;
  713.       case K_ORIGINAL_MODULE:
  714.         module->origmodulename = strval;
  715.         break;
  716.       case K_ORIGINAL_VARIANTS:
  717.         module->origvariants = interp_variant_defns(cdr(bdg));
  718.         break;
  719.       case K_ORIGINAL_VERSION:
  720.         module->origversion = strval;
  721.         break;
  722.       default:
  723.         unknown_property("game module", module->name, propname);
  724.     }
  725.     }
  726.     /* Should be smarter about earlier vs later versions. */
  727.     if (!empty_string(module->programversion)
  728.     && strcmp(module->programversion, version_string()) != 0) {
  729.     /* This should become some sort of alert on some systems. */
  730.     read_warning("The module `%s' is claimed to be for Xconq version `%s', but you are actually running version `%s'",
  731.              module->name, module->programversion, version_string());
  732.     }
  733. }
  734.  
  735. /* The following code is unneeded if all the types have been compiled in. */
  736.  
  737. #ifndef SPECIAL
  738.  
  739. /* Create a new type of unit and fill in info about it. */
  740.  
  741. static void
  742. interp_utype(form)
  743. Obj *form;
  744. {
  745.     int u;
  746.     Obj *name = cadr(form), *utype;
  747.  
  748.     TYPECHECK(symbolp, name, "unit-type name not a symbol");
  749.     if (!canaddutype)
  750.       read_warning("Should not be defining more unit types");
  751.     if (numutypes < MAXUTYPES) {
  752.     u = numutypes++;
  753.     utype = new_utype(u);
  754.     /* Set default values for the unit type's props first. */
  755.     /* Any default type name shouldn't confuse the code below. */
  756.     default_unit_type(u);
  757.     setq(name, utype);
  758.     /* Set the values of random props. */
  759.     fill_in_utype(u, cddr(form));
  760.     /* If no internal type name string given, use the defined name. */
  761.     if (empty_string(u_internal_name(u))) {
  762.         set_u_internal_name(u, c_string(name));
  763.     }
  764.     if (empty_string(u_type_name(u))) {
  765.         set_u_type_name(u, u_internal_name(u));
  766.     }
  767.     /* If the official type name is different from the internal name,
  768.        make it a variable bound to the type. */ 
  769.     if (strcmp(u_type_name(u), u_internal_name(u)) != 0) {
  770.         setq(intern_symbol(u_type_name(u)), utype);
  771.     }
  772.     } else {
  773.     too_many_types("unit", MAXUTYPES, name);
  774.     }
  775.     /* Blast any cached list of types. */
  776.     makunbound(intern_symbol(keyword_name(K_USTAR)));
  777.     eval_symbol(intern_symbol(keyword_name(K_USTAR)));
  778. }
  779.  
  780. /* Trudge through assorted properties, filling them in. */
  781.  
  782. static void
  783. fill_in_utype(u, list)
  784. int u;
  785. Obj *list;
  786. {
  787.     char *propname;
  788.     Obj *bdg, *val;
  789.  
  790.     for ( ; list != lispnil; list = cdr(list)) {
  791.     bdg = car(list);
  792.     PARSE_PROPERTY(bdg, propname, val);
  793.     set_utype_property(u, propname, val);
  794.     }
  795. }
  796.  
  797. /* Given a unit type, property name, and a value, find the
  798.    definition of the property and set its value. */
  799.  
  800. static int
  801. set_utype_property(u, propname, val)
  802. int u;
  803. char *propname;
  804. Obj *val;
  805. {
  806.     int i, found = FALSE, numval;
  807.     char *strval;
  808.  
  809.     for (i = 0; utypedefns[i].name != NULL; ++i) {
  810.     if (strcmp(propname, utypedefns[i].name) == 0) {
  811.         if (utypedefns[i].intgetter) {
  812.         val = eval(val);
  813.         if (!numberishp(val)) {
  814.             read_warning("unit type %s property %s value not a number",
  815.                  u_type_name(u), utypedefns[i].name);
  816.             return TRUE;
  817.         }
  818.         numval = c_number(val);
  819.         if (!between(utypedefns[i].lo, numval, utypedefns[i].hi)) {
  820.             read_warning("unit type %s property %s value %d not between %d and %d",
  821.                  u_type_name(u), utypedefns[i].name, numval,
  822.                  utypedefns[i].lo, utypedefns[i].hi);
  823.             /* Let it pass through, at least for now. */
  824.         }
  825.         TYPEPROP(utypes, u, utypedefns, i, short) = numval;
  826.         } else if (utypedefns[i].strgetter) {
  827.         val = eval(val);
  828.         if (!stringp(val)) {
  829.             read_warning("unit type %s property %s value not a string",
  830.                  u_type_name(u), utypedefns[i].name);
  831.             return TRUE;
  832.         }
  833.         strval = c_string(val);
  834.         TYPEPROP(utypes, u, utypedefns, i, char *) = strval;
  835.         } else {
  836.         TYPEPROP(utypes, u, utypedefns, i, Obj *) = val;
  837.         }
  838.         found = TRUE;
  839.         break;
  840.     }
  841.     }
  842.     if (!found)
  843.       unknown_property("unit type", u_type_name(u), propname);
  844.     return found;
  845. }
  846.  
  847. /* Declare a new type of material and fill in info about it. */
  848.  
  849. static void
  850. interp_mtype(form)
  851. Obj *form;
  852. {
  853.     int m;
  854.     Obj *name = cadr(form), *mtype;
  855.     
  856.     TYPECHECK(symbolp, name, "material-type name not a symbol");
  857.     if (!canaddmtype)
  858.       read_warning("Should not be defining more material types");
  859.     if (nummtypes < MAXMTYPES) {
  860.     m = nummtypes++;
  861.     mtype = new_mtype(m);
  862.     /* Set default values for the material type's properties first. */
  863.     default_material_type(m);
  864.     setq(name, mtype);
  865.     /* Set the values of random props. */
  866.     fill_in_mtype(m, cddr(form));
  867.     /* If no type name string given, use the defined name. */
  868.     if (empty_string(m_type_name(m))) {
  869.         set_m_type_name(m, c_string(name));
  870.     }
  871.     } else {
  872.     too_many_types("material", MAXMTYPES, name);
  873.     }
  874.     /* Blast and remake any cached list of types. */
  875.     makunbound(intern_symbol(keyword_name(K_MSTAR)));
  876.     eval_symbol(intern_symbol(keyword_name(K_MSTAR)));
  877. }
  878.  
  879. /* Go through a list of prop name/value pairs and fill in the
  880.    material type description from them. */
  881.  
  882. static void
  883. fill_in_mtype(m, list)
  884. int m;
  885. Obj *list;
  886. {
  887.     int i, found, numval;
  888.     char *strval;
  889.     Obj *bdg, *val;
  890.     char *propname;
  891.  
  892.     for ( ; list != lispnil; list = cdr(list)) {
  893.     bdg = car(list);
  894.     PARSE_PROPERTY(bdg, propname, val);
  895.     found = FALSE;
  896.     for (i = 0; mtypedefns[i].name != NULL; ++i) {
  897.         if (strcmp(propname, mtypedefns[i].name) == 0) {
  898.         if (mtypedefns[i].intgetter) {
  899.             val = eval(val);
  900.             if (!numberishp(val)) {
  901.             read_warning("material type %s property %s value not a number",
  902.                      m_type_name(m), mtypedefns[i].name);
  903.             return;
  904.             }
  905.             numval = c_number(val);
  906.             if (!between(mtypedefns[i].lo, numval, mtypedefns[i].hi)) {
  907.             read_warning("material type %s property %s value %d not between %d and %d",
  908.                      m_type_name(m), mtypedefns[i].name, numval,
  909.                      mtypedefns[i].lo, mtypedefns[i].hi);
  910.             /* Let it pass through, at least for now. */
  911.             }
  912.             TYPEPROP(mtypes, m, mtypedefns, i, short) = numval;
  913.         } else if (mtypedefns[i].strgetter) {
  914.             val = eval(val);
  915.             if (!stringp(val)) {
  916.             read_warning("material type %s property %s value not a string",
  917.                      m_type_name(m), mtypedefns[i].name);
  918.             return;
  919.             }
  920.             strval = c_string(val);
  921.             TYPEPROP(mtypes, m, mtypedefns, i, char *) = strval;
  922.         } else {
  923.             TYPEPROP(mtypes, m, mtypedefns, i, Obj *) = val;
  924.         }
  925.         found = TRUE;
  926.         break;
  927.         }
  928.     }
  929.     if (!found)
  930.       unknown_property("material type", m_type_name(m), propname);
  931.     }
  932. }
  933.  
  934. /* Declare a new type of terrain and fill in info about it. */
  935.  
  936. static void
  937. interp_ttype(form)
  938. Obj *form;
  939. {
  940.     int t;
  941.     Obj *name = cadr(form), *ttype;
  942.  
  943.     TYPECHECK(symbolp, name, "terrain-type name not a symbol");
  944.     if (!canaddttype)
  945.       read_warning("Should not be defining more terrain types");
  946.     if (numttypes < MAXTTYPES) {
  947.     t = numttypes++;
  948.     ttype = new_ttype(t);
  949.     /* Set default values for the terrain type's props first. */
  950.     default_terrain_type(t);
  951.     setq(name, ttype);
  952.     /* Set the values of random properties. */
  953.     fill_in_ttype(t, cddr(form));
  954.     /* If no type name string given, use the defined name. */
  955.     if (empty_string(t_type_name(t))) {
  956.         set_t_type_name(t, c_string(name));
  957.     }
  958.     } else {
  959.     too_many_types("terrain", MAXTTYPES, name);
  960.     }
  961.     /* Blast and remake any cached list of all types. */
  962.     makunbound(intern_symbol(keyword_name(K_TSTAR)));
  963.     eval_symbol(intern_symbol(keyword_name(K_TSTAR)));
  964. }
  965.  
  966. /* Go through a list of prop name/value pairs and fill in the
  967.    terrain type description from them. */
  968.  
  969. static void
  970. fill_in_ttype(t, list)
  971. int t;
  972. Obj *list;
  973. {
  974.     int i, found, numval;
  975.     char *strval;
  976.     char *propname;
  977.     Obj *bdg, *val;
  978.  
  979.     for ( ; list != lispnil; list = cdr(list)) {
  980.     bdg = car(list);
  981.     PARSE_PROPERTY(bdg, propname, val);
  982.     found = FALSE;
  983.     for (i = 0; ttypedefns[i].name != NULL; ++i) {
  984.         if (strcmp(propname, ttypedefns[i].name) == 0) {
  985.         if (ttypedefns[i].intgetter) {
  986.             val = eval(val);
  987.             if (!numberishp(val)) {
  988.             read_warning("terrain type %s property %s value not a number",
  989.                      t_type_name(t), ttypedefns[i].name);
  990.             return;
  991.             }
  992.             numval = c_number(val);
  993.             if (!between(ttypedefns[i].lo, numval, ttypedefns[i].hi)) {
  994.             read_warning("terrain type %s property %s value %d not between %d and %d",
  995.                      t_type_name(t), ttypedefns[i].name, numval,
  996.                      ttypedefns[i].lo, ttypedefns[i].hi);
  997.             /* Let it pass through, at least for now. */
  998.             }
  999.             TYPEPROP(ttypes, t, ttypedefns, i, short) = numval;
  1000.         } else if (ttypedefns[i].strgetter) {
  1001.             val = eval(val);
  1002.             if (!stringp(val)) {
  1003.             read_warning("terrain type %s property %s value not a string",
  1004.                      t_type_name(t), ttypedefns[i].name);
  1005.             return;
  1006.             }
  1007.             strval = c_string(val);
  1008.             TYPEPROP(ttypes, t, ttypedefns, i, char *) = strval;
  1009.         } else {
  1010.             TYPEPROP(ttypes, t, ttypedefns, i, Obj *) = val;
  1011.         }
  1012.         found = TRUE;
  1013.         break;
  1014.         }
  1015.     }
  1016.     if (!found)
  1017.       unknown_property("terrain type", t_type_name(t), propname);
  1018.     }
  1019.     /* Recalculate the count of subtypes. */
  1020.     count_terrain_subtypes();
  1021. }
  1022.  
  1023. /* Fill in a table. */
  1024.  
  1025. static void
  1026. interp_table(form)
  1027. Obj *form;
  1028. {
  1029.     int i, found, reset = TRUE;
  1030.     Obj *formsym = cadr(form), *body = cddr(form);
  1031.     char *tablename;
  1032.  
  1033.     TYPECHECK(symbolp, formsym, "table name not a symbol");
  1034.     tablename = c_string(formsym);
  1035.     found = FALSE;
  1036.     for (i = 0; tabledefns[i].name != NULL; ++i) {
  1037.     if (strcmp(tablename, tabledefns[i].name) == 0) {
  1038.         if (match_keyword(car(body), K_ADD)) {
  1039.         body = cdr(body);
  1040.         reset = FALSE;
  1041.         }
  1042.         allocate_table(i, reset);
  1043.         add_to_table(formsym, i, body);
  1044.         found = TRUE;
  1045.         break;
  1046.     }
  1047.     }
  1048.     if (!found)
  1049.       read_warning( "Undefined table `%s'", tablename);
  1050. }
  1051.  
  1052. /* Given a table and a list of value-setting clauses, fill in the table. */
  1053.  
  1054. #define INDEXP(typ, x) \
  1055.   ((typ == UTYP) ? utypep(x) : ((typ == MTYP) ? mtypep(x) : ttypep(x)))
  1056.  
  1057. #define nonlist(x) (!consp(x) && x != lispnil)
  1058.  
  1059. #define CHECK_INDEX_1(tbl, x)  \
  1060.   if (!INDEXP(tabledefns[tbl].index1, (x))) {  \
  1061.       read_warning("table %s index 1 has wrong type",  \
  1062.            tabledefns[tbl].name);  \
  1063.       return;  \
  1064.   }
  1065.  
  1066. #define CHECK_INDEX_2(tbl, x)  \
  1067.   if (!INDEXP(tabledefns[tbl].index2, (x))) {  \
  1068.       read_warning("table %s index 2 has wrong type",  \
  1069.            tabledefns[tbl].name);  \
  1070.       return;  \
  1071.   }
  1072.  
  1073. #define CHECK_VALUE(tbl, x)  \
  1074.   if (!numberp(x)) {  \
  1075.       read_warning("table %s value is not a number",  \
  1076.            tabledefns[tbl].name);  \
  1077.       return;  \
  1078.   } \
  1079.   { int checknum = c_number(x);  \
  1080.     if (!between(tabledefns[tbl].lo, checknum, tabledefns[tbl].hi)) {  \
  1081.     read_warning("table %s value %d not within bounds %d to %d",  \
  1082.              tabledefns[tbl].name, checknum, tabledefns[tbl].lo, tabledefns[tbl].hi);  \
  1083.     return;  \
  1084.     }  \
  1085.   }
  1086.  
  1087. #define CHECK_LISTS(tablename, lis1, lis2)  \
  1088.   if (consp(lis2)  \
  1089.       && !list_lengths_match(lis1, lis2, "table", tablename))  {  \
  1090.       return;  \
  1091.   }
  1092.  
  1093.  
  1094. static void
  1095. add_to_table(tablename, tbl, clauses)
  1096. int tbl;
  1097. Obj *tablename, *clauses;
  1098. {
  1099.     int i, num, lim1, lim2;
  1100.     Obj *clause, *indexes1, *indexes2, *values;
  1101.  
  1102.     lim1 = numtypes_from_index_type(tabledefns[tbl].index1);
  1103.     lim2 = numtypes_from_index_type(tabledefns[tbl].index2);
  1104.     for ( ; clauses != lispnil; clauses = cdr(clauses)) {
  1105.     clause = car(clauses);
  1106.     switch (clause->type) {
  1107.       case SYMBOL:
  1108.         clause = eval_symbol(clause);
  1109.         TYPECHECK(numberp, clause, "table clause does not eval to number");
  1110.         /* Now treat it as a number. */
  1111.       case NUMBER:
  1112.         /* A constant value for the table - blast over everything. */
  1113.         CHECK_VALUE(tbl, clause);
  1114.         num = c_number(clause);
  1115.         /* Make sure the table is allocated first. */
  1116.         if (tabledefns[tbl].table == NULL)
  1117.           allocate_table(tbl, TRUE);
  1118.         for (i = 0; i < lim1 * lim2; ++i)
  1119.           (*(tabledefns[tbl].table))[i] = num;
  1120.         break;
  1121.       case CONS:
  1122.         /* Evaluate the three parts of a clause. */
  1123.         indexes1 = eval(car(clause));
  1124.         indexes2 = eval(cadr(clause));
  1125.         values = eval(caddr(clause));
  1126.         if (cdr(cddr(clause)) != lispnil) {
  1127.         sprintlisp(readerrbuf, clause);
  1128.         read_warning("In table `%s', extra junk at end of clause `%s', ignoring",
  1129.                  c_string(tablename), readerrbuf);
  1130.         }
  1131.         interp_one_clause(tablename, tbl, lim1, lim2,
  1132.                   indexes1, indexes2, values);
  1133.         break;
  1134.       case STRING:
  1135.         break; /* error? */
  1136.       default:
  1137.         /* who knows? */
  1138.         break;
  1139.     }
  1140.     }
  1141. }
  1142.  
  1143. static void
  1144. interp_one_clause(tablename, tbl, lim1, lim2, indexes1, indexes2, values)
  1145. Obj *tablename, *indexes1, *indexes2, *values;
  1146. int tbl, lim1, lim2;
  1147. {
  1148.     int i, j, num;
  1149.     Obj *tmp1, *tmp2, *in1, *in2, *value, *subvalue;
  1150.  
  1151.     if (nonlist(indexes1)) {
  1152.     CHECK_INDEX_1(tbl, indexes1);
  1153.     i = c_number(indexes1);
  1154.     if (nonlist(indexes2) ) {
  1155.         CHECK_INDEX_2(tbl, indexes2);
  1156.         j = c_number(indexes2);
  1157.         value = values;
  1158.         CHECK_VALUE(tbl, value);
  1159.         num = c_number(value);
  1160.         (*(tabledefns[tbl].table))[lim2 * i + j] = num;
  1161.     } else {
  1162.         CHECK_LISTS(tablename, indexes2, values);
  1163.         for_all_list(indexes2, tmp2) {
  1164.         in2 = car(tmp2);
  1165.         CHECK_INDEX_2(tbl, in2);
  1166.         j = c_number(in2);
  1167.         value = (consp(values) ? car(values) : values);
  1168.         CHECK_VALUE(tbl, value);
  1169.         num = c_number(value);
  1170.         (*(tabledefns[tbl].table))[lim2 * i + j] = num;
  1171.         if (consp(values))
  1172.           values = cdr(values);
  1173.         }
  1174.     }
  1175.     } else {
  1176.     CHECK_LISTS(tablename, indexes1, values);
  1177.     for_all_list(indexes1, tmp1) {
  1178.         in1 = car(tmp1);
  1179.         CHECK_INDEX_1(tbl, in1);
  1180.         i = c_number(in1);
  1181.         value = (consp(values) ? car(values) : values);
  1182.         if (nonlist(indexes2)) {
  1183.         CHECK_INDEX_2(tbl, indexes2);
  1184.         j = c_number(indexes2);
  1185.         CHECK_VALUE(tbl, value);
  1186.         num = c_number(value);
  1187.         (*(tabledefns[tbl].table))[lim2 * i + j] = num;
  1188.         } else {
  1189.         if (nonlist(value)) {
  1190.             subvalue = value;
  1191.             CHECK_VALUE(tbl, subvalue);
  1192.             num = c_number(subvalue);
  1193.             for_all_list(indexes2, tmp2) {
  1194.             in2 = car(tmp2);
  1195.             CHECK_INDEX_2(tbl, in2);
  1196.             j = c_number(in2);
  1197.             (*(tabledefns[tbl].table))[lim2 * i + j] = num;
  1198.             }
  1199.         } else {
  1200.             CHECK_LISTS(tablename, indexes2, value);
  1201.             for_all_list(indexes2, tmp2) {
  1202.             in2 = car(tmp2);
  1203.             CHECK_INDEX_2(tbl, in2);
  1204.             j = c_number(in2);
  1205.             subvalue = car(value);
  1206.             CHECK_VALUE(tbl, subvalue);
  1207.             num = c_number(subvalue);
  1208.             (*(tabledefns[tbl].table))[lim2 * i + j] = num;
  1209.             value = cdr(value);
  1210.             }
  1211.         }
  1212.         }
  1213.         if (consp(values))
  1214.           values = cdr(values);
  1215.     }
  1216.     }
  1217. }
  1218.  
  1219. /* Set the binding of an existing known variable. */
  1220.  
  1221. static void
  1222. interp_variable(form, isnew)
  1223. Obj *form;
  1224. int isnew;
  1225. {
  1226.     int i, numval;
  1227.     Obj *var = cadr(form);
  1228.     Obj *val = eval(caddr(form));
  1229.     char *name;
  1230.  
  1231.     SYNTAX(form, symbolp(var), "variable is not a symbol");
  1232.     name = c_string(var);
  1233.  
  1234.     if (isnew) {
  1235.     if (boundp(var))
  1236.       read_warning("Symbol `%s' has been bound already, overwriting", name);
  1237.     setq(var, val);
  1238.     } else {
  1239.     /* Look through the set of defined globals. */
  1240.     for (i = 0; vardefns[i].name != 0; ++i) {
  1241.         if (strcmp(name, vardefns[i].name) == 0) {
  1242.         if (vardefns[i].intgetter != NULL) {
  1243.             TYPECHECK(numberishp, val, "is not a number or type");
  1244.             numval = c_number(val);
  1245.             if (!between(vardefns[i].lo, numval, vardefns[i].hi)) {
  1246.             read_warning("global %s value %d not between %d and %d",
  1247.                      vardefns[i].name, numval,
  1248.                      vardefns[i].lo, vardefns[i].hi);
  1249.             /* Let it pass through, at least for now. */
  1250.             }
  1251.             (*(vardefns[i].intsetter))(numval);
  1252.         } else if (vardefns[i].strgetter != NULL) {
  1253.             TYPECHECK(stringp, val, "is not a string");
  1254.             (*(vardefns[i].strsetter))(c_string(val));
  1255.         } else if (vardefns[i].objgetter != NULL) {
  1256.             (*(vardefns[i].objsetter))(val);
  1257.         } else {
  1258.             abort();
  1259.         }
  1260.         return;
  1261.         }
  1262.     }
  1263.     /* Try as a random symbol. */
  1264.     if (boundp(var)) {
  1265.         setq(var, val);
  1266.         return;
  1267.     }
  1268.     /* Out of luck. */
  1269.     read_warning("Can't set unknown global named `%s'", name);
  1270.     }
  1271. }
  1272.  
  1273. static void
  1274. undefine_variable(form)
  1275. Obj *form;
  1276. {
  1277.     Obj *var = cadr(form);
  1278.  
  1279.     if (!symbolp(var)) {
  1280.     read_warning("Can't undefine a non-symbol!");
  1281.     return;
  1282.     }
  1283.     makunbound(var);
  1284. }
  1285.  
  1286. /* General function to augment types. */
  1287.  
  1288. static void
  1289. add_properties(form)
  1290. Obj *form;
  1291. {
  1292.     Obj *rest, *types, *prop, *values;
  1293.  
  1294.     rest = cdr(form);
  1295.     types = eval(car(rest));
  1296.     rest = cdr(rest);
  1297.     prop = car(rest);
  1298.     SYNTAX(form, symbolp(prop), "not a property name in third position");
  1299.     rest = cdr(rest);
  1300.     SYNTAX(form, rest != lispnil, "no property values supplied");
  1301.     values = eval(car(rest));
  1302.     /* Complain about, but ignore, extra things. */
  1303.     if (cdr(rest) != lispnil) {
  1304.     sprintlisp(readerrbuf, form);
  1305.     read_warning("Extra junk at the end of `%s', ignoring", readerrbuf);
  1306.     }
  1307.     if (utypep(types) || (consp(types) && utypep(car(types)))) {
  1308.     add_to_utypes(types, prop, values);
  1309.     } else if (mtypep(types) || (consp(types) && mtypep(car(types)))) {
  1310.     add_to_mtypes(types, prop, values);
  1311.     } else if (ttypep(types) || (consp(types) && ttypep(car(types)))) {
  1312.     add_to_ttypes(types, prop, values);
  1313.     } else {
  1314.     sprintlisp(readerrbuf, form);
  1315.     read_warning("No types to add to in `%s'", readerrbuf);
  1316.     }
  1317. }
  1318.  
  1319. /* Compare a list of types with a list of values, complain if
  1320.    they don't match up. */
  1321.  
  1322. static int
  1323. list_lengths_match(types, values, formtype, form)
  1324. Obj *types, *values, *form;
  1325. char *formtype;
  1326. {
  1327.     if (length(types) != length(values)) {
  1328.     sprintlisp(spbuf, form);
  1329.     read_warning("Lists of differing lengths (%d vs %d) in %s `%s'",
  1330.              length(types), length(values), formtype, spbuf);
  1331.     return FALSE;
  1332.     }
  1333.     return TRUE;
  1334. }
  1335.  
  1336. static void
  1337. add_to_utypes(types, prop, values)
  1338. Obj *types, *prop, *values;
  1339. {
  1340.     char *propname = c_string(prop);
  1341.     Obj *lis1, *lis2;
  1342.  
  1343.     if (utypep(types)) {
  1344.     set_utype_property(types->v.num, propname, values);
  1345.     } else if (consp(types)) {
  1346.     if (consp(values)) {
  1347.         if (!list_lengths_match(types, values, "utype property", prop))
  1348.           return;
  1349.         for_both_lists(types, values, lis1, lis2) {
  1350.         TYPECHECK(utypep, car(lis1), "not a unit type");
  1351.         if (!set_utype_property(car(lis1)->v.num, propname, car(lis2)))
  1352.           break;
  1353.         }
  1354.     } else {
  1355.         for_all_list(types, lis1) {
  1356.         TYPECHECK(utypep, car(lis1), "not a unit type");
  1357.         if (!set_utype_property(car(lis1)->v.num, propname, values))
  1358.           break;
  1359.         }
  1360.     }
  1361.     }
  1362. }
  1363.  
  1364. static void
  1365. add_to_mtypes(types, prop, values)
  1366. Obj *types, *prop, *values;
  1367. {
  1368.     Obj *lis1, *lis2;
  1369.  
  1370.     if (mtypep(types)) {
  1371.     fill_in_mtype(types->v.num,
  1372.               cons(cons(prop, cons(values, lispnil)), lispnil));
  1373.     } else if (consp(types)) {
  1374.     if (consp(values)) {
  1375.         if (!list_lengths_match(types, values, "mtype property", prop))
  1376.           return;
  1377.         for_both_lists(types, values, lis1, lis2) {
  1378.         TYPECHECK(mtypep, car(lis1), "not a unit type");
  1379.         fill_in_mtype(car(lis1)->v.num,
  1380.                   cons(cons(prop, cons(car(lis2), lispnil)),
  1381.                    lispnil));
  1382.         }
  1383.     } else {
  1384.         for_all_list(types, lis1) {
  1385.         TYPECHECK(mtypep, car(lis1), "not a material type");
  1386.         fill_in_mtype(car(lis1)->v.num,
  1387.                   cons(cons(prop, cons(values, lispnil)),
  1388.                    lispnil));
  1389.         }
  1390.     }
  1391.     }
  1392. }
  1393.  
  1394. static void
  1395. add_to_ttypes(types, prop, values)
  1396. Obj *types, *prop, *values;
  1397. {
  1398.     Obj *lis1, *lis2;
  1399.  
  1400.     if (ttypep(types)) {
  1401.     fill_in_ttype(types->v.num,
  1402.               cons(cons(prop, cons(values, lispnil)), lispnil));
  1403.     } else if (consp(types)) {
  1404.     if (consp(values)) {
  1405.         if (!list_lengths_match(types, values, "ttype property", prop))
  1406.           return;
  1407.         for_both_lists(types, values, lis1, lis2) {
  1408.         TYPECHECK(ttypep, car(lis1), "not a terrain type");
  1409.         fill_in_ttype(car(lis1)->v.num,
  1410.                   cons(cons(prop, cons(car(lis2), lispnil)),
  1411.                    lispnil));
  1412.         }
  1413.     } else {
  1414.         for_all_list(types, lis1) {
  1415.         TYPECHECK(ttypep, car(lis1), "not a terrain type");
  1416.         fill_in_ttype(car(lis1)->v.num,
  1417.                   cons(cons(prop, cons(values, lispnil)),
  1418.                    lispnil));
  1419.         }
  1420.     }
  1421.     }
  1422. }
  1423.  
  1424. #endif /* n SPECIAL */
  1425.  
  1426. /* Interpret a world-specifying form. */
  1427.  
  1428. static void
  1429. interp_world(form)
  1430. Obj *form;
  1431. {
  1432.     int numval;
  1433.     Obj *props, *bdg, *propval;
  1434.     char *propname;
  1435.  
  1436.     props = cdr(form);
  1437.     if (symbolp(car(props))) {
  1438.     /* This is the id of the world (eventually). */
  1439.     props = cdr(props);
  1440.     }
  1441.     if (numberp(car(props))) {
  1442.         set_world_circumference(c_number(car(props)), TRUE);
  1443.     props = cdr(props);
  1444.     }
  1445.     for ( ; props != lispnil; props = cdr(props)) {
  1446.     bdg = car(props);
  1447.     PARSE_PROPERTY(bdg, propname, propval);
  1448.     if (numberp(propval))
  1449.       numval = c_number(propval);
  1450.     switch (keyword_code(propname)) {
  1451.       case K_CIRCUMFERENCE:
  1452.         set_world_circumference(numval, TRUE);
  1453.         break;
  1454.       case K_DAY_LENGTH:
  1455.         world.daylength = numval;
  1456.         break;
  1457.       case K_YEAR_LENGTH:
  1458.         world.yearlength = numval;
  1459.         break;
  1460.       case K_AXIAL_TILT:
  1461.         world.axialtilt = numval;
  1462.         break;
  1463.       default:
  1464.         unknown_property("world", "", propname);
  1465.     }
  1466.     }
  1467. }
  1468.  
  1469. /* Only one area, of fixed size.  Created anew if shape/size is supplied, else
  1470.    just modified. */
  1471.  
  1472. static void
  1473. interp_area(form)
  1474. Obj *form;
  1475. {
  1476.     int newarea = FALSE, newwidth = 0, newheight = 0, numval;
  1477.     Obj *props, *subprop, *bdg, *propval, *rest;
  1478.     char *propname;
  1479.  
  1480.     props = cdr(form);
  1481.     /* (eventually this will be an id or name) */
  1482.     if (symbolp(car(props))) {
  1483.     props = cdr(props);
  1484.     newarea = TRUE;
  1485.     }
  1486.     /* Collect the width of the area. */
  1487.     if (numberp(car(props))) {
  1488.     newwidth = newheight = c_number(car(props));
  1489.         if (area.fullwidth == 0)
  1490.       newarea = TRUE;
  1491.     if (area.fullwidth > 0 && area.fullwidth != newwidth)
  1492.       read_warning("weird areas - %d vs %d", area.fullwidth, newwidth);
  1493.     props = cdr(props);
  1494.     }
  1495.     /* Collect the height of the area. */
  1496.     if (numberp(car(props))) {
  1497.     newheight = c_number(car(props));
  1498.         if (area.fullheight == 0)
  1499.       newarea = TRUE;
  1500.     if (area.fullheight > 0 && area.fullheight != newheight)
  1501.       read_warning("weird areas - %d vs %d", area.fullheight, newheight);
  1502.     props = cdr(props);
  1503.     }
  1504.     /* See if we're restricting ourselves to a piece of a larger area. */
  1505.     if (consp(car(props))
  1506.         && match_keyword(car(car(props)), K_RESTRICT)) {
  1507.         subprop = cdr(car(props));
  1508.         if (numberp(car(subprop))) {
  1509.         area.fullwidth = c_number(car(subprop));
  1510.         subprop = cdr(subprop);
  1511.         TYPECHECK(numberp, car(subprop), "restriction parm not a number");
  1512.         area.fullheight = c_number(car(subprop));
  1513.         subprop = cdr(subprop);
  1514.         TYPECHECK(numberp, car(subprop), "restriction parm not a number");
  1515.         area.fullx = c_number(car(subprop));
  1516.         subprop = cdr(subprop);
  1517.         TYPECHECK(numberp, car(subprop), "restriction parm not a number");
  1518.         area.fully = c_number(car(subprop));
  1519.         } else if (match_keyword(car(subprop), K_RESET)) {
  1520.         area.fullwidth = area.fullheight = 0;
  1521.         area.fullx = area.fully = 0;
  1522.         } else {
  1523.         syntax_error(car(props), "not 4 numbers or \"reset\"");
  1524.         return;
  1525.         }
  1526.     props = cdr(props);        
  1527.     }
  1528.     /* If this is setting the area's shape for the first time,
  1529.        actually do it. */
  1530.     if (newarea)
  1531.       set_area_shape(newwidth, newheight, TRUE);
  1532.     for ( ; props != lispnil; props = cdr(props)) {
  1533.     bdg = car(props);
  1534.     PARSE_PROPERTY(bdg, propname, propval);
  1535.     if (numberp(propval))
  1536.       numval = c_number(propval);
  1537.     rest = cdr(bdg);
  1538.     switch (keyword_code(propname)) {
  1539.       case K_WIDTH:
  1540.         /* Note that this may fail if the height has to change at
  1541.            at the same time. */
  1542.         set_area_shape(numval, area.height, TRUE);
  1543.         break;
  1544.       case K_HEIGHT:
  1545.         /* Note that this may fail if the width has to change at
  1546.            at the same time. */
  1547.         set_area_shape(area.width, numval, TRUE);
  1548.         break;
  1549.       case K_LATITUDE:
  1550.         area.latitude = numval;
  1551.         break;
  1552.       case K_LONGITUDE:
  1553.         area.longitude = numval;
  1554.         break;
  1555.       case K_CELL_WIDTH:
  1556.         area.cellwidth = numval;
  1557.         break;
  1558.       case K_TERRAIN:
  1559.         fill_in_terrain(rest);
  1560.         break;
  1561.       case K_AUX_TERRAIN:
  1562.         fill_in_aux_terrain(rest);
  1563.         break;
  1564.       case K_PEOPLE_SIDES:
  1565.         fill_in_people_sides(rest);
  1566.         break;
  1567.       case K_FEATURES:
  1568.         fill_in_features(rest);
  1569.         break;
  1570.       case K_ELEVATIONS:
  1571.         fill_in_elevations(rest);
  1572.         break;
  1573.       case K_MATERIAL:
  1574.         fill_in_cell_material(rest);
  1575.         break;
  1576.       case K_TEMPERATURES:
  1577.         fill_in_temperatures(rest);
  1578.         break;
  1579.       case K_WINDS:
  1580.         fill_in_winds(rest);
  1581.         break;
  1582.       case K_CLOUDS:
  1583.         fill_in_clouds(rest);
  1584.         break;
  1585.       case K_CLOUD_BOTTOMS:
  1586.         fill_in_cloud_bottoms(rest);
  1587.         break;
  1588.       case K_CLOUD_HEIGHTS:
  1589.         fill_in_cloud_heights(rest);
  1590.         break;
  1591.       default:
  1592.         unknown_property("area", "", propname);
  1593.     }
  1594.     }
  1595. }
  1596.  
  1597. /* The general plan of reading is similar for all layers - create a blank
  1598.    layer if none allocated, then call read_layer and pass a function that will
  1599.    actually put a value into a cell of the layer.  We need to define those
  1600.    functions because most of the setters are macros, and because we can do
  1601.    some extra error checking. */
  1602.  
  1603. /* Read the area terrain. */
  1604.  
  1605. static void
  1606. fill_in_terrain(contents)
  1607. Obj *contents;
  1608. {
  1609.     /* We must have some terrain types or we're going to lose bigtime. */
  1610.     if (numttypes == 0)
  1611.       load_default_game();
  1612.     numbadterrain = 0;
  1613.     /* Make sure the terrain layer exists. */
  1614.     if (!terrain_defined())
  1615.       allocate_area_terrain();
  1616.     read_layer(contents, fn_set_terrain_at);
  1617.     if (numbadterrain > 0) {
  1618.     read_warning("%d occurrences of unknown terrain in all",
  1619.              numbadterrain);
  1620.     }
  1621. }
  1622.  
  1623. /* Read a layer of auxiliary terrain. */
  1624.  
  1625. static void
  1626. fill_in_aux_terrain(contents)
  1627. Obj *contents;
  1628. {
  1629.     int t;
  1630.     Obj *typesym = car(contents), *typeval;
  1631.  
  1632.     if (symbolp(typesym) && ttypep(typeval = eval(typesym))) {
  1633.     t = c_number(typeval);
  1634.     contents = cdr(contents);
  1635.     /* Make sure aux terrain space exists, but don't overwrite. */
  1636.     allocate_area_aux_terrain(t);
  1637.     tmpttype = t;
  1638.     read_layer(contents, fn_set_aux_terrain_at);
  1639.     /* Ensure that borders and connections have all their bits
  1640.        correctly set. */
  1641.     patch_linear_terrain(t);
  1642.     } else {
  1643.     /* not a valid aux terrain type */
  1644.     }
  1645. }
  1646.  
  1647. static void
  1648. fill_in_people_sides(contents)
  1649. Obj *contents;
  1650. {
  1651.     /* Make sure the people sides layer exists. */
  1652.     allocate_area_people_sides();
  1653.     read_layer(contents, fn_set_people_side_at);
  1654. }
  1655.  
  1656. /* This should recompute size etc of all these features too. */
  1657.  
  1658. static void
  1659. fill_in_features(contents)
  1660. Obj *contents;
  1661. {
  1662.     int fid;
  1663.     Obj *featspec, *flist;
  1664.     Feature *feat;
  1665.  
  1666.     init_features();
  1667.     for (flist = car(contents); flist != lispnil; flist = cdr(flist)) {
  1668.     featspec = car(flist);
  1669.     fid = 0;
  1670.     feat = NULL;
  1671.     if (numberp(car(featspec))) {
  1672.         fid = c_number(car(featspec));
  1673.         feat = find_feature(fid);
  1674.         featspec = cdr(featspec);
  1675.     }
  1676.     if (feat == NULL) {
  1677.         feat = create_feature(c_string(car(featspec)),
  1678.                   c_string(cadr(featspec)));
  1679.         if (fid > 0)
  1680.           feat->id = fid;
  1681.     } else {
  1682.         /* complain if data doesn't match? */
  1683.     }
  1684.     }
  1685.     read_layer(cdr(contents), fn_set_raw_feature_at);
  1686. }
  1687.  
  1688. static void
  1689. fill_in_elevations(contents)
  1690. Obj *contents;
  1691. {
  1692.     /* Make sure the elevation layer exists. */
  1693.     allocate_area_elevations();
  1694.     read_layer(contents, fn_set_elevation_at);
  1695. }
  1696.  
  1697. static void
  1698. fill_in_cell_material(contents)
  1699. Obj *contents;
  1700. {
  1701.     int m;
  1702.     Obj *typesym = car(contents), *typeval;
  1703.  
  1704.     if (symbolp(typesym) && mtypep(typeval = eval(typesym))) {
  1705.     m = c_number(typeval);
  1706.     contents = cdr(contents);
  1707.     /* Make sure this material layer exists. */
  1708.     allocate_area_material(m);
  1709.     tmpmtype = m;
  1710.     read_layer(contents, fn_set_material_at);
  1711.     } else {
  1712.     /* not a valid material type spec, should warn */
  1713.     }
  1714. }
  1715.  
  1716. static void
  1717. fill_in_temperatures(contents)
  1718. Obj *contents;
  1719. {
  1720.     /* Make sure the temperature layer exists. */
  1721.     allocate_area_temperatures();
  1722.     read_layer(contents, fn_set_temperature_at);
  1723. }
  1724.  
  1725. static void
  1726. fill_in_winds(contents)
  1727. Obj *contents;
  1728. {
  1729.     /* Make sure the winds layer exists. */
  1730.     allocate_area_winds();
  1731.     read_layer(contents, fn_set_raw_wind_at);
  1732. }
  1733.  
  1734. static void
  1735. fill_in_clouds(contents)
  1736. Obj *contents;
  1737. {
  1738.     /* Make sure the clouds layer exists. */
  1739.     allocate_area_clouds();
  1740.     read_layer(contents, fn_set_raw_cloud_at);
  1741. }
  1742.  
  1743. static void
  1744. fill_in_cloud_bottoms(contents)
  1745. Obj *contents;
  1746. {
  1747.     /* Make sure the cloud bottoms layer exists. */
  1748.     allocate_area_cloud_bottoms();
  1749.     read_layer(contents, fn_set_raw_cloud_bottom_at);
  1750. }
  1751.  
  1752. static void
  1753. fill_in_cloud_heights(contents)
  1754. Obj *contents;
  1755. {
  1756.     /* Make sure the cloud heights layer exists. */
  1757.     allocate_area_cloud_heights();
  1758.     read_layer(contents, fn_set_raw_cloud_height_at);
  1759. }
  1760.  
  1761. /* This is like init_warning, but with a module and line(s) glued in. */
  1762. /* (This may seem like a strange position for this routine, but it's
  1763.    necessary to accommodate a Mac 16-bit PC-relative addressing limit;
  1764.    in the middle of the file, it's close enough to all of its callers.
  1765.    Nasty remarks about Mac runtime architecture to Dev:Null please.) */
  1766.  
  1767. void
  1768. #ifdef __STDC__
  1769. read_warning(char *str, ...)
  1770. #else
  1771. read_warning(str, a1, a2, a3, a4, a5, a6, a7, a8, a9)
  1772. char *str;
  1773. long a1, a2, a3, a4, a5, a6, a7, a8, a9;
  1774. #endif
  1775. {
  1776.     char buf[BUFSIZE];
  1777.  
  1778.     module_and_line(curmodule, buf);
  1779. #ifdef __STDC__
  1780.     {
  1781.     va_list ap;
  1782.  
  1783.     va_start(ap, str);
  1784.     vtprintf(buf, str, ap);
  1785.     va_end(ap);
  1786.     }
  1787. #else
  1788.     tprintf(buf, str, a1, a2, a3, a4, a5, a6, a7, a8, a9);
  1789. #endif
  1790.     low_init_warning(buf);
  1791. }
  1792.  
  1793. /* Interpret a side spec. */
  1794.  
  1795. static void
  1796. interp_side(form, side)
  1797. Obj *form;
  1798. Side *side;
  1799. {
  1800.     int id = -1;
  1801.     Obj *ident = lispnil, *sym = lispnil, *props = cdr(form);
  1802.  
  1803.     /* See if there's an optional side identifier and pick it off. */
  1804.     if (!listp(car(props))) {
  1805.     ident = car(props);
  1806.     props = cdr(props);
  1807.     }
  1808.     if (numberp(ident)) {
  1809.     id = c_number(ident);
  1810.     side = side_n(id);
  1811.     } else if (symbolp(ident)) {
  1812.     if (boundp(ident) && numberp(symbol_value(ident))) {
  1813.         id = c_number(symbol_value(ident));
  1814.         side = side_n(id);
  1815.     } else {
  1816.         sym = ident;
  1817.     }
  1818.     } else if (stringp(ident)) {
  1819.     side = find_side_by_name(c_string(ident));
  1820.     } else {
  1821.     /* We want to create a new side. */
  1822.     }
  1823.     if (symbolp(car(props))) {
  1824.     sym = car(props);
  1825.     props = cdr(props);
  1826.     }
  1827.     if (side == NULL) {
  1828.     side = create_side();
  1829.     /* Replace with the read-in id if it was given. */
  1830.     if (id >= 0)
  1831.       side->id = id;
  1832.     }
  1833.     if (sym != lispnil) {
  1834.     /* Record the symbol as going with this side. */
  1835.     /* (should warn if existing symbol being overwritten?) */
  1836.     side->symbol = sym;
  1837.     /* Also let it eval to the side's id. */
  1838.     setq(sym, new_number(side->id));
  1839.     }
  1840.     /* Apply the current side defaults first. */
  1841.     fill_in_side(side, side_defaults, FALSE);
  1842.     /* Now fill in from the explicitly specified properties. */
  1843.     fill_in_side(side, props, FALSE);
  1844.     Dprintf("  Got side %s\n", side_desig(side));
  1845. }
  1846.  
  1847. /* Given a side, fill in some of its properties. */
  1848.  
  1849. void
  1850. fill_in_side(side, props, userdata)
  1851. Side *side;
  1852. Obj *props;
  1853. int userdata;
  1854. {
  1855.     int numval = 0, permission;
  1856.     char *propname, *strval = NULL;
  1857.     Obj *bdg, *rest, *propval;
  1858.  
  1859. #define CHECK_PERMISSION  \
  1860.         if (userdata) {  \
  1861.         permission = FALSE;  \
  1862.         break;  \
  1863.         }
  1864.  
  1865.     for (; props != lispnil; props = cdr(props)) {
  1866.     permission = TRUE;
  1867.     bdg = car(props);
  1868.     PARSE_PROPERTY(bdg, propname, propval);
  1869.     if (symbolp(propval))
  1870.       propval = eval(propval);
  1871.     if (numberp(propval))
  1872.       numval = c_number(propval);
  1873.     if (stringp(propval))
  1874.       strval = c_string(propval);
  1875.     rest = cdr(bdg);
  1876.     switch (keyword_code(propname)) {
  1877.       case K_NAME:
  1878.         check_name_uniqueness(side, strval, "name");
  1879.         side->name = strval;
  1880.         break;
  1881.       case K_LONG_NAME:
  1882.         check_name_uniqueness(side, strval, "long name");
  1883.         side->longname = strval;
  1884.         break;
  1885.       case K_SHORT_NAME:
  1886.         check_name_uniqueness(side, strval, "short name");
  1887.         side->shortname = strval;
  1888.         break;
  1889.       case K_NOUN:
  1890.         check_name_uniqueness(side, strval, "noun");
  1891.         side->noun = strval;
  1892.         break;
  1893.       case K_PLURAL_NOUN:
  1894.         check_name_uniqueness(side, strval, "plural noun");
  1895.         side->pluralnoun = strval;
  1896.         break;
  1897.       case K_ADJECTIVE:
  1898.         check_name_uniqueness(side, strval, "adjective");
  1899.         side->adjective = strval;
  1900.         break;
  1901.           /* Several synonyms are allowed for specifying colors. */
  1902.       case K_COLOR:
  1903.         side->colorscheme = strval;
  1904.         break;
  1905.       case K_EMBLEM_NAME:
  1906.         side->emblemname = strval;
  1907.         break;
  1908.       case K_UNIT_NAMERS:
  1909.         /* Allocate space if not already done so. */
  1910.         if (side->unitnamers == NULL)
  1911.           side->unitnamers = (char **) xmalloc(numutypes * sizeof(char *));
  1912.         merge_unit_namers(side, rest);
  1913.         break;
  1914.       case K_FEATURE_NAMERS:
  1915.         /* (should merge instead of bashing) */
  1916.         side->featurenamers = rest;
  1917.         break;
  1918.       case K_NAMES_LOCKED:
  1919.         side->nameslocked = numval;
  1920.         break;
  1921.       case K_CLASS:
  1922.         CHECK_PERMISSION;
  1923.         side->sideclass = strval;
  1924.         break;
  1925.       case K_SELF_UNIT:
  1926.         CHECK_PERMISSION;
  1927.         side->self_unit_id = numval;
  1928.         break;
  1929.       case K_CONTROLLED_BY:
  1930.         side->controlled_by_id = numval;
  1931.         break;
  1932.       case K_TRUSTS:
  1933.         interp_side_value_list(side->trusts, rest);
  1934.         break;
  1935.       case K_TRADES:
  1936.         interp_side_value_list(side->trades, rest);
  1937.         break;
  1938.       case K_START_WITH:
  1939.         CHECK_PERMISSION;
  1940.         if (side->startwith == NULL)
  1941.           side->startwith = (short *) xmalloc(numutypes * sizeof(short));
  1942.         interp_utype_value_list(side->startwith, rest);
  1943.         break;
  1944.       case K_NEXT_NUMBERS:
  1945.         CHECK_PERMISSION;
  1946.         if (side->counts == NULL)
  1947.           side->counts = (short *) xmalloc(numutypes * sizeof(short));
  1948.         interp_utype_value_list(side->counts, rest);
  1949.         break;
  1950.       case K_TECH:
  1951.         CHECK_PERMISSION;
  1952.         if (side->tech == NULL)
  1953.           side->tech = (short *) xmalloc(numutypes * sizeof(short));
  1954.         interp_utype_value_list(side->tech, rest);
  1955.         break;
  1956.       case K_INIT_TECH:
  1957.         CHECK_PERMISSION;
  1958.         if (side->inittech == NULL)
  1959.           side->inittech = (short *) xmalloc(numutypes * sizeof(short));
  1960.         interp_utype_value_list(side->inittech, rest);
  1961.         break;
  1962.       case K_DEFAULT_DOCTRINE:
  1963.         read_general_doctrine(side, rest);
  1964.         break;
  1965.       case K_DOCTRINES:
  1966.         read_utype_doctrine(side, rest);
  1967.         break;
  1968.       case K_DOCTRINES_LOCKED:
  1969.         side->doctrines_locked = numval;
  1970.         break;
  1971.       case K_TERRAIN_VIEW:
  1972.         CHECK_PERMISSION;
  1973.         read_view_layer(side, rest, fn_set_terrain_view);
  1974.         break;
  1975.       case K_TERRAIN_VIEW_DATES:
  1976.         CHECK_PERMISSION;
  1977.         read_view_layer(side, rest, fn_set_terrain_view_date);
  1978.         break;
  1979.       case K_AUX_TERRAIN_VIEW:
  1980.         CHECK_PERMISSION;
  1981.         read_aux_terrain_view_layer(side, rest, fn_set_aux_terrain_view);
  1982.         break;
  1983.       case K_AUX_TERRAIN_VIEW_DATES:
  1984.         CHECK_PERMISSION;
  1985.         read_aux_terrain_view_layer(side, rest, fn_set_aux_terrain_view_date);
  1986.         break;
  1987.       case K_UNIT_VIEW:
  1988.         CHECK_PERMISSION;
  1989.         read_view_layer(side, rest, fn_set_unit_view);
  1990.         break;
  1991.       case K_UNIT_VIEW_DATES:
  1992.         CHECK_PERMISSION;
  1993.         read_view_layer(side, rest, fn_set_unit_view_date);
  1994.         break;
  1995.       case K_MATERIAL_VIEW:
  1996.         CHECK_PERMISSION;
  1997.         read_material_view_layer(side, rest, fn_set_material_view);
  1998.         break;
  1999.       case K_MATERIAL_VIEW_DATES:
  2000.         CHECK_PERMISSION;
  2001.         read_material_view_layer(side, rest, fn_set_material_view_date);
  2002.         break;
  2003.       case K_TEMPERATURE_VIEW:
  2004.         CHECK_PERMISSION;
  2005.         read_view_layer(side, rest, fn_set_temp_view);
  2006.         break;
  2007.       case K_TEMPERATURE_VIEW_DATES:
  2008.         CHECK_PERMISSION;
  2009.         read_view_layer(side, rest, fn_set_temp_view_date);
  2010.         break;
  2011.       case K_CLOUD_VIEW:
  2012.         CHECK_PERMISSION;
  2013.         read_view_layer(side, rest, fn_set_cloud_view);
  2014.         break;
  2015.       case K_CLOUD_BOTTOM_VIEW:
  2016.         CHECK_PERMISSION;
  2017.         read_view_layer(side, rest, fn_set_cloud_bottom_view);
  2018.         break;
  2019.       case K_CLOUD_HEIGHT_VIEW:
  2020.         CHECK_PERMISSION;
  2021.         read_view_layer(side, rest, fn_set_cloud_height_view);
  2022.         break;
  2023.       case K_CLOUD_VIEW_DATES:
  2024.         CHECK_PERMISSION;
  2025.         read_view_layer(side, rest, fn_set_cloud_view_date);
  2026.         break;
  2027.       case K_WIND_VIEW:
  2028.         CHECK_PERMISSION;
  2029.         read_view_layer(side, rest, fn_set_wind_view);
  2030.         break;
  2031.       case K_WIND_VIEW_DATES:
  2032.         CHECK_PERMISSION;
  2033.         read_view_layer(side, rest, fn_set_wind_view_date);
  2034.         break;
  2035.       case K_ACTIVE:
  2036.         CHECK_PERMISSION;
  2037.         side->ingame = numval;
  2038.         break;
  2039.       case K_EVER_ACTIVE:
  2040.         CHECK_PERMISSION;
  2041.         side->everingame = numval;
  2042.         break;
  2043.       case K_PRIORITY:
  2044.         CHECK_PERMISSION;
  2045.         side->priority = numval;
  2046.         break;
  2047.       case K_STATUS:
  2048.         CHECK_PERMISSION;
  2049.         side->status = numval;
  2050.         break;
  2051.       case K_SCORES:
  2052.         CHECK_PERMISSION;
  2053.         /* The data in this slot will be interpreted later,
  2054.            after scorekeepers exist. */
  2055.         side->rawscores = rest;
  2056.         break;
  2057.       case K_WILLING_TO_DRAW:
  2058.         side->willingtodraw = numval;
  2059.         break;
  2060.       case K_FINISHED_TURN:
  2061.         side->finishedturn = numval;
  2062.         break;
  2063.       case K_TURN_TIME_USED:
  2064.         CHECK_PERMISSION;
  2065.         side->turntimeused = numval;
  2066.         break;
  2067.       case K_TOTAL_TIME_USED:
  2068.         CHECK_PERMISSION;
  2069.         side->totaltimeused = numval;
  2070.         break;
  2071.       case K_TIMEOUTS:
  2072.         CHECK_PERMISSION;
  2073.         side->timeouts = numval;
  2074.         break;
  2075.       case K_TIMEOUTS_USED:
  2076.         CHECK_PERMISSION;
  2077.         side->timeoutsused = numval;
  2078.         break;
  2079.       case K_ADVANTAGE:
  2080.         CHECK_PERMISSION;
  2081.         side->advantage = numval;
  2082.         break;
  2083.       case K_ADVANTAGE_MIN:
  2084.         CHECK_PERMISSION;
  2085.         side->minadvantage = numval;
  2086.         break;
  2087.       case K_ADVANTAGE_MAX:
  2088.         CHECK_PERMISSION;
  2089.         side->maxadvantage = numval;
  2090.         break;
  2091.       case K_PLAYER:
  2092.         side->playerid = numval;
  2093.         break;
  2094.       case K_GAIN_COUNTS:
  2095.         CHECK_PERMISSION;
  2096.         interp_short_array(side->gaincounts, rest, numutypes * num_gain_reasons);
  2097.         break;
  2098.       case K_LOSS_COUNTS:
  2099.         CHECK_PERMISSION;
  2100.         interp_short_array(side->losscounts, rest, numutypes * num_loss_reasons);
  2101.         break;
  2102.       case K_ATTACK_STATS:
  2103.         CHECK_PERMISSION;
  2104.         interp_atkstats_list(side, rest);
  2105.         break;
  2106.       case K_HIT_STATS:
  2107.         CHECK_PERMISSION;
  2108.         interp_hitstats_list(side, rest);
  2109.         break;
  2110.       case K_AI_DATA:
  2111.         /* The data in this slot will be interpreted when the AI is
  2112.            ready to look at it. */
  2113.         side->aidata = rest;
  2114.         break;
  2115.       case K_UI_DATA:
  2116.         /* The data in this slot will be interpreted when the interface
  2117.            is ready to look at it. */
  2118.         side->uidata = rest;
  2119.         break;
  2120.       default:
  2121.         unknown_property("side", side_desig(side), propname);
  2122.     }
  2123.     if (!permission) {
  2124.         read_warning("No permission to set property `%s'", propname);
  2125.     }
  2126.     }
  2127.     /* Calculate the plural form of the noun for units if it was not
  2128.        explicitly defined. */
  2129.     if (side->noun != NULL && side->pluralnoun == NULL) {
  2130.     side->pluralnoun = copy_string(plural_form(side->noun));
  2131.     }
  2132. }
  2133.  
  2134. static void
  2135. check_name_uniqueness(side, str, kind)
  2136. Side *side;
  2137. char *str, *kind;
  2138. {
  2139.     if (name_in_use(side, str)) {
  2140.     init_warning("Side %s `%s' is already in use", kind, str);
  2141.     }
  2142. }
  2143.  
  2144. /* Given a list of (utype str) pairs, set unit namers appropriately. */
  2145.  
  2146. static void
  2147. merge_unit_namers(side, lis)
  2148. Side *side;
  2149. Obj *lis;
  2150. {
  2151.     int u, u2 = 0;
  2152.     Obj *rest, *elt, *types, *namer;
  2153.  
  2154.     for_all_list(lis, rest) {
  2155.     elt = car(rest);
  2156.     if (consp(elt)) {
  2157.         types = eval(car(elt));
  2158.         namer = cadr(elt);
  2159.         if (utypep(types) && (stringp(namer) || symbolp(namer))) {
  2160.         u = c_number(types);
  2161.         side->unitnamers[u] = c_string(namer);
  2162.         } else {
  2163.         syntax_error(elt, "garbled unit namer");
  2164.         }
  2165.     } else if (stringp(elt) || symbolp(elt)) {
  2166.         if (u2 < numutypes) {
  2167.         side->unitnamers[u2++] = c_string(elt);
  2168.         } else {
  2169.         read_warning("more unit namers than unit types, ignoring extra");
  2170.         }
  2171.     } else {
  2172.         syntax_error(elt, "not a valid unit namer");
  2173.     }
  2174.     }
  2175. }
  2176.  
  2177. static void
  2178. interp_side_value_list(arr, lis)
  2179. short *arr;
  2180. Obj *lis;
  2181. {
  2182.     int s = 0;
  2183.     Obj *rest, *head;
  2184.  
  2185.     if (arr == NULL)
  2186.       run_error("null array for side value list?");
  2187.     for_all_list(lis, rest) {
  2188.         head = car(rest);
  2189.     if (numberp(head)) {
  2190.         if (s > g_sides_max())
  2191.           break;
  2192.         arr[s++] = c_number(head);
  2193.     } else if (symbolp(head)) {
  2194.         int s2 = c_number(eval(head));
  2195.  
  2196.         if (between(1, s2, g_sides_max()))
  2197.           arr[s2] = TRUE;
  2198.         else
  2199.           read_warning("bad side spec");
  2200.     } else if (consp(head)) {
  2201.         Obj *sidespec = car(head);
  2202.         int s2, val2 = c_number(cadr(head));
  2203.  
  2204.         if (numberp(sidespec) || symbolp(sidespec)) {
  2205.         s2 = c_number(eval(sidespec));
  2206.         if (between(1, s2, g_sides_max()))
  2207.           arr[s2] = val2;
  2208.         else
  2209.           read_warning("bad side spec");
  2210.         } else if (consp(sidespec)) {
  2211.             read_warning("not implemented");
  2212.         } else {
  2213.             read_warning("not implemented");
  2214.         }
  2215.     } else {
  2216.         read_warning("not implemented");
  2217.     }
  2218.     }
  2219. }
  2220.  
  2221. static void
  2222. interp_atkstats_list(side, lis)
  2223. Side *side;
  2224. Obj *lis;
  2225. {
  2226.     int u, u2;
  2227.     Obj *rest, *head;
  2228.  
  2229.     for_all_list(lis, rest) {
  2230.         head = car(rest);
  2231.         if (consp(head) && symbolp(car(head))) {
  2232.         u = utype_from_symbol(car(head));
  2233.         if (!is_unit_type(u)) {
  2234.         init_warning("non unit type");
  2235.         continue;
  2236.         }
  2237.         if (side->atkstats[u] == NULL)
  2238.           side->atkstats[u] = (long *) xmalloc(numutypes * sizeof(long));
  2239.         interp_long_array(side->atkstats[u], cdr(head), numutypes);
  2240.     }
  2241.     }
  2242. }
  2243.  
  2244. static void
  2245. interp_hitstats_list(side, lis)
  2246. Side *side;
  2247. Obj *lis;
  2248. {
  2249.     int u, u2;
  2250.     Obj *rest, *head;
  2251.  
  2252.     for_all_list(lis, rest) {
  2253.         head = car(rest);
  2254.         if (consp(head) && symbolp(car(head))) {
  2255.         u = utype_from_symbol(car(head));
  2256.         if (!is_unit_type(u)) {
  2257.         init_warning("non unit type");
  2258.         continue;
  2259.         }
  2260.         if (side->hitstats[u] == NULL)
  2261.           side->hitstats[u] = (long *) xmalloc(numutypes * sizeof(long));
  2262.         interp_long_array(side->hitstats[u], cdr(head), numutypes);
  2263.     }
  2264.     }
  2265. }
  2266.  
  2267. /* Helper function to init side view from rle encoding. */
  2268. /* (should move these into side.c?) */
  2269.  
  2270. static void
  2271. fn_set_terrain_view(x, y, val)
  2272. int x, y, val;
  2273. {
  2274.     set_terrain_view(tmpside, x, y, val);
  2275. }
  2276.  
  2277. static void
  2278. fn_set_terrain_view_date(x, y, val)
  2279. int x, y, val;
  2280. {
  2281.     set_terrain_view_date(tmpside, x, y, val);
  2282. }
  2283.  
  2284. static void
  2285. fn_set_unit_view(x, y, val)
  2286. int x, y, val;
  2287. {
  2288.     set_unit_view(tmpside, x, y, val);
  2289. }
  2290.  
  2291. static void
  2292. fn_set_unit_view_date(x, y, val)
  2293. int x, y, val;
  2294. {
  2295.     set_unit_view_date(tmpside, x, y, val);
  2296. }
  2297.  
  2298. static void
  2299. fn_set_temp_view(x, y, val)
  2300. int x, y, val;
  2301. {
  2302.     set_temperature_view(tmpside, x, y, val);
  2303. }
  2304.  
  2305. static void
  2306. fn_set_temp_view_date(x, y, val)
  2307. int x, y, val;
  2308. {
  2309.     set_temperature_view_date(tmpside, x, y, val);
  2310. }
  2311.  
  2312. static void
  2313. fn_set_cloud_view(x, y, val)
  2314. int x, y, val;
  2315. {
  2316.     set_cloud_view(tmpside, x, y, val);
  2317. }
  2318.  
  2319. static void
  2320. fn_set_cloud_bottom_view(x, y, val)
  2321. int x, y, val;
  2322. {
  2323.     set_cloud_bottom_view(tmpside, x, y, val);
  2324. }
  2325.  
  2326. static void
  2327. fn_set_cloud_height_view(x, y, val)
  2328. int x, y, val;
  2329. {
  2330.     set_cloud_height_view(tmpside, x, y, val);
  2331. }
  2332.  
  2333. static void
  2334. fn_set_cloud_view_date(x, y, val)
  2335. int x, y, val;
  2336. {
  2337.     set_cloud_view_date(tmpside, x, y, val);
  2338. }
  2339.  
  2340. static void
  2341. fn_set_wind_view(x, y, val)
  2342. int x, y, val;
  2343. {
  2344.     set_wind_view(tmpside, x, y, val);
  2345. }
  2346.  
  2347. static void
  2348. fn_set_wind_view_date(x, y, val)
  2349. int x, y, val;
  2350. {
  2351.     set_wind_view_date(tmpside, x, y, val);
  2352. }
  2353.  
  2354. static void
  2355. read_view_layer(side, contents, setter)
  2356. Side *side;
  2357. Obj *contents;
  2358. void (*setter) PARAMS ((int x, int y, int val));
  2359. {
  2360.     if (g_see_all())
  2361.       return;
  2362.     init_view(side);
  2363.     tmpside = side;
  2364.     read_layer(contents, setter);
  2365. }
  2366.  
  2367. static void
  2368. fn_set_aux_terrain_view(x, y, val)
  2369. int x, y, val;
  2370. {
  2371.     /* Filter anything but the basic six bits. */
  2372.     val &= 0x3f;
  2373.     set_aux_terrain_view(tmpside, x, y, tmpttype, val);
  2374. }
  2375.  
  2376. static void
  2377. fn_set_aux_terrain_view_date(x, y, val)
  2378. int x, y, val;
  2379. {
  2380.     set_aux_terrain_view_date(tmpside, x, y, tmpttype, val);
  2381. }
  2382.  
  2383. static void
  2384. read_aux_terrain_view_layer(side, contents, setter)
  2385. Side *side;
  2386. Obj *contents;
  2387. void (*setter) PARAMS ((int x, int y, int val));
  2388. {
  2389.     int t;
  2390.     Obj *typesym = car(contents), *typeval;
  2391.  
  2392.     if (g_see_all())
  2393.       return;
  2394.     init_view(side);
  2395.     tmpside = side;
  2396.     if (!symbolp(typesym)) {
  2397.     return;
  2398.     }
  2399.     typeval = eval(typesym);
  2400.     if (!ttypep(typeval)) {
  2401.     return;
  2402.     }
  2403.     t = c_number(typeval);
  2404.     if (!t_is_cell(t)) {
  2405.     return;
  2406.     }
  2407.     contents = cdr(contents);
  2408.     tmpttype = t;
  2409.     read_layer(contents, setter);
  2410. }
  2411.  
  2412. static void
  2413. fn_set_material_view(x, y, val)
  2414. int x, y, val;
  2415. {
  2416.     set_material_view(tmpside, x, y, tmpmtype, val);
  2417. }
  2418.  
  2419. static void
  2420. fn_set_material_view_date(x, y, val)
  2421. int x, y, val;
  2422. {
  2423.     set_material_view_date(tmpside, x, y, tmpmtype, val);
  2424. }
  2425.  
  2426. static void
  2427. read_material_view_layer(side, contents, setter)
  2428. Side *side;
  2429. Obj *contents;
  2430. void (*setter) PARAMS ((int x, int y, int val));
  2431. {
  2432.     int m;
  2433.     Obj *typesym = car(contents), *typeval;
  2434.  
  2435.     if (all_see_all)
  2436.       return;
  2437.     init_view(side);
  2438.     tmpside = side;
  2439.     if (!symbolp(typesym)) {
  2440.     return;
  2441.     }
  2442.     typeval = eval(typesym);
  2443.     if (!mtypep(typeval)) {
  2444.     return;
  2445.     }
  2446.     m = c_number(typeval);
  2447.     contents = cdr(contents);
  2448.     tmpmtype = m;
  2449.     read_layer(contents, setter);
  2450. }
  2451.  
  2452. static void
  2453. read_general_doctrine(side, props)
  2454. Side *side;
  2455. Obj *props;
  2456. {
  2457.     int id = -1;
  2458.     char *name = NULL;
  2459.     Obj *ident = lispnil;
  2460.     Doctrine *doctrine = NULL;
  2461.  
  2462.     if (props == lispnil) {
  2463.     /* (should complain) */
  2464.     return;
  2465.     }
  2466.     ident = car(props);
  2467.     props = cdr(props);
  2468.     if (numberp(ident)) {
  2469.     id = c_number(ident);
  2470.     doctrine = find_doctrine(id);
  2471.     } else if (symbolp(ident) || stringp(ident)) {
  2472.     name = c_string(ident);
  2473.     doctrine = find_doctrine_by_name(name);
  2474.     } else {
  2475.     type_error(ident, "invalid doctrine reference");
  2476.     return;
  2477.     }
  2478.     if (doctrine == NULL) {
  2479.     doctrine = new_doctrine(id);
  2480.     doctrine->name = name;
  2481.     }
  2482.     fill_in_doctrine(doctrine, props);
  2483.     side->default_doctrine = doctrine;
  2484. }
  2485.  
  2486. /* Read doctrine info pertaining to a particular unit type. */
  2487.  
  2488. static void
  2489. read_utype_doctrine(side, lis)
  2490. Side *side;
  2491. Obj *lis;
  2492. {
  2493.     short arr[MAXUTYPES];
  2494.     int u, id;
  2495.     char *name;
  2496.     Obj *item, *rest, *ulist, *props, *ident;
  2497.     Doctrine *doctrine;
  2498.     
  2499.     for_all_list(lis, rest) {
  2500.     item = car(rest);
  2501.     ulist = car(item);
  2502.     props = cdr(item);
  2503.     for_all_unit_types(u)
  2504.       arr[u] = FALSE;
  2505.     interp_utype_list(arr, ulist);
  2506.     ident = car(props);
  2507.     props = cdr(props);
  2508.     id = 0;
  2509.     name = NULL;
  2510.     if (numberp(ident)) {
  2511.         id = c_number(ident);
  2512.         doctrine = find_doctrine(id);
  2513.     } else if (symbolp(ident) || stringp(ident)) {
  2514.         name = c_string(ident);
  2515.         doctrine = find_doctrine_by_name(name);
  2516.     } else {
  2517.         type_error(ident, "invalid doctrine reference");
  2518.         return;
  2519.     }
  2520.     if (doctrine == NULL) {
  2521.         doctrine = new_doctrine(id);
  2522.         doctrine->name = name;
  2523.     }
  2524.     fill_in_doctrine(doctrine, props);
  2525.     for_all_unit_types(u) {
  2526.         if (arr[u]) {
  2527.         if (side->udoctrine == NULL)
  2528.           init_doctrine(side);
  2529.         side->udoctrine[u] = doctrine;
  2530.         }
  2531.     }
  2532.     }
  2533. }
  2534.  
  2535. /* Interpret a form as a doctrine. */
  2536.  
  2537. static void
  2538. interp_doctrine(form)
  2539. Obj *form;
  2540. {
  2541.     int id = -1;
  2542.     char *name = NULL;
  2543.     Obj *ident = lispnil, *props = cdr(form);
  2544.     Doctrine *doctrine = NULL;
  2545.  
  2546.     /* Pick up an optional numeric or symbolic id. */
  2547.     if (props != lispnil) {
  2548.     if (!consp(car(props))) {
  2549.         ident = car(props);
  2550.         props = cdr(props);
  2551.     }
  2552.     }
  2553.     /* Use the id to find an existing doctrine. */
  2554.     if (numberp(ident)) {
  2555.     id = c_number(ident);
  2556.     doctrine = find_doctrine(id);
  2557.     }
  2558.     if (symbolp(ident)) {
  2559.     name = c_string(ident);
  2560.     doctrine = find_doctrine_by_name(name);
  2561.     }
  2562.     if (doctrine == NULL) {
  2563.     doctrine = new_doctrine(id);
  2564.     doctrine->name = name;
  2565.     }
  2566.     /* Give the symbol a binding so eval'ing works. */
  2567.     if (symbolp(ident))
  2568.       setq(ident, new_string(name));
  2569.     fill_in_doctrine(doctrine, props);
  2570.     Dprintf("  Got doctrine\n");
  2571. }
  2572.  
  2573. static void
  2574. fill_in_doctrine(doctrine, props)
  2575. Doctrine *doctrine;
  2576. Obj *props;
  2577. {
  2578.     int numval;
  2579.     char *propname;
  2580.     Obj *bdg, *val;
  2581.  
  2582.     for (; props != lispnil; props = cdr(props)) {
  2583.     bdg = car(props);
  2584.     PARSE_PROPERTY(bdg, propname, val);
  2585.     if (numberp(val))
  2586.       numval = c_number(val);
  2587.     switch (keyword_code(propname)) {
  2588.       case K_EVER_ASK_SIDE:
  2589.         doctrine->everaskside = numval;
  2590.         break;
  2591.       case K_CONSTRUCTION_RUN:
  2592.         /* Ensure that we have something to write into. */
  2593.         /* (assumes that numutypes already frozen - always true?) */
  2594.         if (doctrine->construction_run == NULL)
  2595.           doctrine->construction_run =
  2596.             (short *) xmalloc (numutypes * sizeof(short));
  2597.         interp_utype_value_list(doctrine->construction_run, cdr(bdg));
  2598.         break;
  2599.       case K_LOCKED:
  2600.         doctrine->locked = numval;
  2601.         break;
  2602.       default:
  2603.         unknown_property("doctrine", "", propname);
  2604.     }
  2605.     }
  2606. }
  2607.  
  2608. /* Interpret a form that defines a player. */
  2609.  
  2610. static void
  2611. interp_player(form)
  2612. Obj *form;
  2613. {
  2614.     int id = -1;
  2615.     Obj *ident = lispnil, *props = cdr(form);
  2616.     Player *player = NULL;
  2617.  
  2618.     if (props != lispnil) {
  2619.     if (!consp(car(props))) {
  2620.         ident = car(props);
  2621.         props = cdr(props);
  2622.     }
  2623.     }
  2624.     if (numberp(ident)) {
  2625.     id = c_number(ident);
  2626.     player = find_player(id);
  2627.     }
  2628.     if (player == NULL) {
  2629.     player = add_player();
  2630.     }
  2631.     if (id > 0)
  2632.       player->id = id;
  2633.     fill_in_player(player, props);
  2634.     Dprintf("  Got player %s\n", player_desig(player));
  2635. }
  2636.  
  2637. static void
  2638. fill_in_player(player, props)
  2639. Player *player;
  2640. Obj *props;
  2641. {
  2642.     char *propname, *strval;
  2643.     Obj *bdg, *propval;
  2644.  
  2645.     for (; props != lispnil; props = cdr(props)) {
  2646.     bdg = car(props);
  2647.     PARSE_PROPERTY(bdg, propname, propval);
  2648.     if (stringp(propval))
  2649.       strval = c_string(propval);
  2650.     switch (keyword_code(propname)) {
  2651.       case K_NAME:
  2652.         player->name = strval;
  2653.         break;
  2654.       case K_CONFIG_NAME:
  2655.         player->configname = strval;
  2656.         break;
  2657.       case K_DISPLAY_NAME:
  2658.         player->displayname = strval;
  2659.         break;
  2660.       case K_AI_TYPE_NAME:
  2661.         player->aitypename = strval;
  2662.         break;
  2663.       case K_INITIAL_ADVANTAGE:
  2664.         player->advantage = c_number(propval);
  2665.         break;
  2666.       case K_PASSWORD:
  2667.         player->password = strval;
  2668.         break;
  2669.       default:
  2670.         unknown_property("player", player_desig(player), propname);
  2671.     }
  2672.     }
  2673.     canonicalize_player(player);
  2674. }
  2675.  
  2676. /* Create and fill in an agreement, as specified by the form. */
  2677.  
  2678. static void
  2679. interp_agreement(form)
  2680. Obj *form;
  2681. {
  2682.     int id = 0;
  2683.     char *propname;
  2684.     Obj *props = cdr(form), *agid, *bdg, *val;
  2685.     Agreement *ag;
  2686.  
  2687.     agid = car(props);
  2688.     if (numberp(agid)) {
  2689.         id = c_number(agid);
  2690.     /* should use the number eventually */
  2691.     props = cdr(props);
  2692.     }
  2693.     if (1 /* must create a new agreement object */) {
  2694.     ag = create_agreement(id);
  2695.     /* Fill in defaults for the slots. */
  2696.     ag->state = draft;  /* default for now */
  2697.     ag->drafters = NOSIDES;
  2698.     ag->proposers = NOSIDES;
  2699.     ag->signers = NOSIDES;
  2700.     ag->willing = NOSIDES;
  2701.     ag->knownto = NOSIDES;
  2702.     }
  2703.     /* Interpret the properties. */
  2704.     for (; props != lispnil; props = cdr(props)) {
  2705.     bdg = car(props);
  2706.     PARSE_PROPERTY(bdg, propname, val);
  2707.     switch (keyword_code(propname)) {
  2708.       case K_TYPE_NAME:
  2709.         ag->typename = c_string(val);
  2710.         break;
  2711.       case K_NAME:
  2712.         ag->name = c_string(val);
  2713.         break;
  2714.       case K_STATE:
  2715.         ag->state = c_number(val);
  2716.         break;
  2717.       case K_TERMS:
  2718.         ag->terms = val;
  2719.         break;
  2720.       case K_DRAFTERS:
  2721.         break;
  2722.       case K_PROPOSERS:
  2723.         break;
  2724.       case K_SIGNERS:
  2725.         break;
  2726.       case K_WILLING_TO_SIGN:
  2727.         break;
  2728.       case K_KNOWN_TO:
  2729.         break;
  2730.       case K_ENFORCEMENT:
  2731.         ag->enforcement = c_number(val);
  2732.         break;
  2733.         break;
  2734.       default:
  2735.         unknown_property("agreement", "", propname);
  2736.     }
  2737.     }
  2738. }
  2739.  
  2740. static void
  2741. interp_unit_defaults(form)
  2742. Obj *form;
  2743. {
  2744.     int u, m, numval, wasnum, variablelength;
  2745.     Obj *props = form, *bdg, *val;
  2746.     char *propname;
  2747.  
  2748.     if (match_keyword(car(props), K_RESET)) {
  2749.     /* Reset all the tweakable defaults. */
  2750.     uxoffset = 0, uyoffset = 0;
  2751.     default_unit_side_number = -1;
  2752.     default_unit_origside_number = -1;
  2753.     default_unit_cp = -1;
  2754.     default_unit_hp = -1;
  2755.     default_unit_cxp = -1;
  2756.     default_unit_z = -1;
  2757.     default_transport_id = -1;
  2758.     default_unit_hook = lispnil;
  2759.     for_all_material_types(m)
  2760.       default_supply[m] = -1;
  2761.     canaddmtype = FALSE;
  2762.     if (default_tooling != NULL) {
  2763.         for_all_unit_types(u)
  2764.           default_tooling[m] = -1;
  2765.     }
  2766.     props = cdr(props);
  2767.     }
  2768.     for (; props != lispnil; props = cdr(props)) {
  2769.     bdg = car(props);
  2770.     PARSE_PROPERTY(bdg, propname, val);
  2771.     numval = 0;
  2772.     wasnum = FALSE;
  2773.     if (numberp(val)) {
  2774.         numval = c_number(val);
  2775.         wasnum = TRUE;
  2776.     }
  2777.     variablelength = FALSE;
  2778.     /* Note that not all unit slots can get default values. */
  2779.     switch (keyword_code(propname)) {
  2780.       case K_AT:
  2781.         uxoffset = numval;
  2782.         uyoffset = c_number(caddr(bdg));
  2783.         /* The property is not really variable-length, but mollify the error check. */
  2784.         variablelength = TRUE;
  2785.         break;
  2786.       case K_S:
  2787.         if (!wasnum)
  2788.           numval = c_number(eval(val));
  2789.         default_unit_side_number = numval;
  2790.         break;
  2791.       case K_OS:
  2792.         if (!wasnum)
  2793.           numval = c_number(eval(val));
  2794.         default_unit_origside_number = numval;
  2795.         break;
  2796.       case K_CP:
  2797.         default_unit_cp = numval;
  2798.         break;
  2799.       case K_HP:
  2800.         default_unit_hp = numval;
  2801.         break;
  2802.       case K_CXP:
  2803.         default_unit_cxp = numval;
  2804.         break;
  2805.       case K_M:
  2806.         interp_mtype_value_list(default_supply, cdr(bdg));
  2807.         variablelength = TRUE;
  2808.         break;
  2809.       case K_TP:
  2810.         if (default_tooling == NULL)
  2811.           default_tooling = (short *) xmalloc(numutypes * sizeof(short));
  2812.         interp_utype_value_list(default_tooling, cdr(bdg));
  2813.         variablelength = TRUE;
  2814.         break;
  2815.       case K_IN:
  2816.         default_transport_id = numval;
  2817.         break;
  2818.       case K_PLAN:
  2819.         /* (should fill in) */
  2820.         variablelength = TRUE;
  2821.         break;
  2822.       case K_Z:
  2823.         default_unit_z = numval;
  2824.         break;
  2825.       case K_X:
  2826.         default_unit_hook = cdr(bdg);
  2827.         variablelength = TRUE;
  2828.         break;
  2829.       default:
  2830.         unknown_property("unit-defaults", "", propname);
  2831.     }
  2832.     if (!variablelength && cddr(bdg) != lispnil)
  2833.       read_warning("Extra junk in a %s property, ignoring", propname);
  2834.     }
  2835. }
  2836.  
  2837. /* Try to find a unit type named by the string. */
  2838. /* (should move these elsewhere) */
  2839.  
  2840. int
  2841. utype_from_name(str)
  2842. char *str;
  2843. {
  2844.     char *tmpstr;
  2845.     int u;
  2846.     Obj *sym;
  2847.  
  2848.     for_all_unit_types(u) {
  2849.     if (strcmp(str, u_type_name(u)) == 0)
  2850.       return u;
  2851.     }
  2852.     /* Try evaluating the symbol. */
  2853.     sym = intern_symbol(str);
  2854.     if (boundp(sym) && utypep(symbol_value(sym)))
  2855.       return c_number(symbol_value(sym));
  2856.     /* Try some less common possibilities. */
  2857.     for_all_unit_types(u) {
  2858.     tmpstr = u_short_name(u);
  2859.     if (tmpstr && strcmp(str, tmpstr) == 0)
  2860.       return u;
  2861.     }
  2862.     for_all_unit_types(u) {
  2863.     tmpstr = u_long_name(u);
  2864.     if (tmpstr && strcmp(str, tmpstr) == 0)
  2865.       return u;
  2866.     }
  2867.     return NONUTYPE;
  2868. }
  2869.  
  2870. /* Try to find a unit type named by the string. */
  2871.  
  2872. int
  2873. utype_from_symbol(sym)
  2874. Obj *sym;
  2875. {
  2876.     char *str, *tmpstr;
  2877.     int u;
  2878.  
  2879.     if (boundp(sym) && utypep(symbol_value(sym)))
  2880.       return c_number(symbol_value(sym));
  2881.     str = c_string(sym);
  2882.     for_all_unit_types(u) {
  2883.     if (strcmp(str, u_type_name(u)) == 0)
  2884.       return u;
  2885.     }
  2886.     /* Try some less common possibilities. */
  2887.     for_all_unit_types(u) {
  2888.     tmpstr = u_short_name(u);
  2889.     if (tmpstr && strcmp(str, tmpstr) == 0)
  2890.       return u;
  2891.     }
  2892.     for_all_unit_types(u) {
  2893.     tmpstr = u_long_name(u);
  2894.     if (tmpstr && strcmp(str, tmpstr) == 0)
  2895.       return u;
  2896.     }
  2897.     return NONUTYPE;
  2898. }
  2899.  
  2900. /* This creates an individual unit and fills in data about it. */
  2901.  
  2902. static void
  2903. interp_unit(form)
  2904. Obj *form;
  2905. {
  2906.     int u, u2, m, tp_varies, numval, wasnum, nuid = 0, variablelength;
  2907.     int nusn = -1, nuosn = -1;
  2908.     char *propname;
  2909.     Obj *head = car(form), *props = cdr(form), *bdg, *val;
  2910.     Unit *unit, *unit2;
  2911.     extern int nextid;
  2912.  
  2913.     Dprintf("Reading a unit from ");
  2914.     Dprintlisp(form);
  2915.     Dprintf("\n");
  2916.     if (symbolp(head)) {
  2917.     u = utype_from_symbol(head);
  2918.          if (u != NONUTYPE) {
  2919.         unit = create_unit(u, FALSE);
  2920.         canaddmtype = FALSE;
  2921.         if (unit == NULL) {
  2922.         read_warning("Failed to create a unit, skipping the form");
  2923.         return;
  2924.         }
  2925.     } else {
  2926.         read_warning("\"%s\" not a known unit type, skipping the form",
  2927.              c_string(head));
  2928.         return;
  2929.     }
  2930.     } else if (stringp(head)) {
  2931.     unit = find_unit_by_name(c_string(head));
  2932.     if (unit == NULL) {
  2933.         read_warning("No unit named \"%s\", skipping the form",
  2934.              c_string(head));
  2935.         return;
  2936.         }
  2937.     } else if (numberp(head)) {
  2938.     unit = find_unit_by_number(c_number(head));
  2939.     if (unit == NULL) {
  2940.         read_warning("No unit numbered %d, skipping the form",
  2941.              c_number(head));
  2942.         return;
  2943.         }
  2944.     }
  2945.     /* At this point we're guaranteed to have a unit to work with. */
  2946.     /* Modify the unit according to current defaults. */
  2947.     if (default_unit_side_number >= 0)
  2948.       nusn = default_unit_side_number;
  2949.     if (default_unit_origside_number >= 0)
  2950.       nuosn = default_unit_origside_number;
  2951.     if (default_unit_cp >= 0)
  2952.       unit->cp = default_unit_cp;
  2953.     if (default_unit_hp >= 0)
  2954.       unit->hp = unit->hp2 = default_unit_hp;
  2955.     if (default_unit_cxp >= 0)
  2956.       unit->cxp = default_unit_cxp;
  2957.     /* First default supplies using the generic supply initialize. */
  2958.     init_supply(unit);
  2959.     /* Then fill in anything from the unit defaults. */
  2960.     for_all_material_types(m) {
  2961.     if (default_supply[m] >= 0)
  2962.       unit->supply[m] = default_supply[m];
  2963.     }
  2964.     /* Fill in any default toolings that might have been set up. */
  2965.     if (default_tooling != NULL) {
  2966.     tp_varies = FALSE;
  2967.     for_all_unit_types(u2) {
  2968.         if (default_tooling[u2] > 0) {
  2969.         tp_varies = TRUE;
  2970.         break;
  2971.         }
  2972.     }
  2973.     if (tp_varies) {
  2974.         if (unit->tooling == NULL)
  2975.           init_unit_tooling(unit);
  2976.         for_all_unit_types(u2)
  2977.           unit->tooling[u] = default_tooling[u];
  2978.     }
  2979.     }
  2980.     /* Peel off fixed-position properties, if they're supplied. */
  2981.     if (numberp(car(props))) {
  2982.     unit->prevx = c_number(car(props)) + uxoffset - area.fullx;
  2983.     props = cdr(props);
  2984.     }
  2985.     if (numberp(car(props))) {
  2986.     unit->prevy = c_number(car(props)) + uyoffset - area.fully;
  2987.     props = cdr(props);
  2988.     }
  2989.     if (props != lispnil && !consp(car(props))) {
  2990.     nusn = c_number(eval(car(props)));
  2991.     props = cdr(props);
  2992.     }
  2993.     /* Now crunch through optional stuff.  The unit's properties must *already*
  2994.        be correct. */
  2995.     for (; props != lispnil; props = cdr(props)) {
  2996.     bdg = car(props);
  2997.     PARSE_PROPERTY(bdg, propname, val);
  2998.     numval = 0;
  2999.     wasnum = FALSE;
  3000.     if (numberp(val)) {
  3001.         numval = c_number(val);
  3002.         wasnum = TRUE;
  3003.     }
  3004.     variablelength = FALSE;
  3005.     switch (keyword_code(propname)) {
  3006.       case K_N:
  3007.         unit->name = c_string(val);
  3008.         break;
  3009.       case K_SHARP:
  3010.         nuid = numval;
  3011.         break;
  3012.       case K_S:
  3013.         if (!wasnum)
  3014.           numval = c_number(eval(val));
  3015.         nusn = numval;
  3016.         break;
  3017.       case K_OS:
  3018.         if (!wasnum)
  3019.           numval = c_number(eval(val));
  3020.         nuosn = numval;
  3021.         break;
  3022.       case K_AT:
  3023.         unit->prevx = numval + uxoffset;
  3024.         unit->prevy = c_number(caddr(bdg)) + uyoffset;
  3025.         variablelength = TRUE;
  3026.         break;
  3027.       case K_NB:
  3028.         unit->number = numval;
  3029.         break;
  3030.       case K_CP:
  3031.         unit->cp = numval;
  3032.         break;
  3033.       case K_HP:
  3034.         /* Note if the unit is read in as damaged, we don't want
  3035.            damage reckoning to replace with a default hp2. */
  3036.         unit->hp = unit->hp2 = numval;
  3037.         break;
  3038.       case K_CXP:
  3039.         unit->cxp = numval;
  3040.         break;
  3041.       case K_MO:
  3042.         unit->morale = numval;
  3043.         break;
  3044.       case K_M:
  3045.         interp_mtype_value_list(unit->supply, cdr(bdg));
  3046.         variablelength = TRUE;
  3047.         break;
  3048.       case K_TP:
  3049.         if (unit->tooling == NULL)
  3050.           init_unit_tooling(unit);
  3051.         interp_utype_value_list(unit->tooling, cdr(bdg));
  3052.         variablelength = TRUE;
  3053.         break;
  3054.       case K_OPINIONS:
  3055.         if (unit->opinions == NULL)
  3056.           init_unit_opinions(unit, numsides);
  3057.         if (unit->opinions != NULL) {
  3058.         interp_side_value_list(unit->opinions, cdr(bdg));
  3059.         } else {
  3060.         read_warning("Unit %s cannot have opinions, ignoring attempt to set",
  3061.                  unit_desig(unit));
  3062.         }
  3063.         variablelength = TRUE;
  3064.         break;
  3065.       case K_IN:
  3066.         /* Stash the Lisp object pointer for now - will be
  3067.            translated to unit pointer later. */
  3068.         unit->transport = (Unit *) val;
  3069.         break;
  3070.       case K_ACT:
  3071.         interp_unit_act(unit, cdr(bdg));
  3072.         variablelength = TRUE;
  3073.         break;
  3074.       case K_PLAN:
  3075.         interp_unit_plan(unit, cdr(bdg));
  3076.         variablelength = TRUE;
  3077.         break;
  3078.       case K_Z:
  3079.         unit->z = numval;
  3080.         break;
  3081.       case K_APPEAR:
  3082.         if (unit->extras == NULL)
  3083.           init_unit_extras(unit);
  3084.         if (numberp(val))
  3085.           unit->extras->appear = numval;
  3086.         variablelength = TRUE;
  3087.         break;
  3088.       case K_DISAPPEAR:
  3089.         if (unit->extras == NULL)
  3090.           init_unit_extras(unit);
  3091.         if (numberp(val))
  3092.           unit->extras->disappear = numval;
  3093.         variablelength = TRUE;
  3094.         break;
  3095.       case K_X:
  3096.         if (unit->extras == NULL)
  3097.           init_unit_extras(unit);
  3098.         unit->extras->hook = cdr(bdg);
  3099.         variablelength = TRUE;
  3100.         break;
  3101.       default:
  3102.         unknown_property("unit", unit_desig(unit), propname);
  3103.     }
  3104.     if (!variablelength && cddr(bdg) != lispnil)
  3105.       read_warning("Extra junk in the %s property of %s, ignoring",
  3106.                propname, unit_desig(unit));
  3107.     }
  3108.     /* If the unit id was given, assign it to the unit, avoiding
  3109.        duplication. */
  3110.     if (nuid > 0) {
  3111.         /* If this id is already in use by some other unit, complain. */
  3112.         unit2 = find_unit(nuid);
  3113.         if (unit2 != NULL && unit2 != unit)
  3114.       init_error("Id %d already in use by %s", nuid, unit_desig(unit2)); 
  3115.          /* Guaranteed distinct, safe to use. */
  3116.     unit->id = nuid;
  3117.     /* Ensure that future random ids won't step on this one. */
  3118.     nextid = max(nextid, nuid + 1);
  3119.     }
  3120.     if (nusn >= 0) {
  3121.     /* (should check that this is an allowed side?) */
  3122.     set_unit_side(unit, side_n(nusn));
  3123.     }
  3124.     if (nuosn >= 0) {
  3125.     /* (should check that this is an allowed side?) */
  3126.     set_unit_origside(unit, side_n(nuosn));
  3127.     } else {
  3128.     set_unit_origside(unit, unit->side);
  3129.     }
  3130.     /* (should fill in hook) */
  3131.     Dprintf("  Got %s\n", unit_desig(unit));
  3132. }
  3133.  
  3134. static void
  3135. interp_utype_list(arr, lis)
  3136. short *arr;
  3137. Obj *lis;
  3138. {
  3139.     int u = 0;
  3140.     Obj *rest, *head;
  3141.  
  3142.     /* Assume that if the destination array does not exist, there is
  3143.        probably a reason, and it's not our concern. */
  3144.     if (arr == NULL)
  3145.       return;
  3146.     lis = eval(lis);
  3147.     if (!consp(lis))
  3148.       lis = cons(lis, lispnil);
  3149.     for_all_list(lis, rest) {
  3150.         head = car(rest);
  3151.         if (utypep(head)) {
  3152.         arr[head->v.num] = TRUE;
  3153.     } else {
  3154.         /* syntax error */
  3155.     }
  3156.     }
  3157. }
  3158.  
  3159. static void
  3160. interp_utype_value_list(arr, lis)
  3161. short *arr;
  3162. Obj *lis;
  3163. {
  3164.     int u = 0;
  3165.     Obj *rest, *head, *types, *values, *subrest, *subrest2;
  3166.  
  3167.     /* Assume that if the destination array does not exist, there is
  3168.        probably a reason, and it's not our concern. */
  3169.     if (arr == NULL)
  3170.       return;
  3171.     for_all_list(lis, rest) {
  3172.         head = car(rest);
  3173.         if (numberp(head)) {
  3174.         if (u < numutypes) {
  3175.             arr[u++] = c_number(head);
  3176.         } else {
  3177.         init_warning("too many numbers in list");
  3178.         }
  3179.     } else if (consp(head)) {
  3180.         types = eval(car(head));
  3181.         values = eval(cadr(head));
  3182.         if (utypep(types)) {
  3183.         u = types->v.num;
  3184.             arr[u++] = c_number(values);
  3185.         } else if (consp(values)) {
  3186.         for_both_lists(types, values, subrest, subrest2) {
  3187.             TYPECHECK(utypep, car(subrest), "not a unit type");
  3188.             u = car(subrest)->v.num;
  3189.             arr[u++] = c_number(car(subrest2));
  3190.         }
  3191.         } else {
  3192.         for_all_list(types, subrest) {
  3193.             TYPECHECK(utypep, car(subrest), "not a unit type");
  3194.             u = car(subrest)->v.num;
  3195.             arr[u++] = c_number(values);
  3196.         }
  3197.         }
  3198.     } else {
  3199.         /* syntax error */
  3200.     }
  3201.     }
  3202. }
  3203.  
  3204. static void
  3205. interp_mtype_value_list(arr, lis)
  3206. short *arr;
  3207. Obj *lis;
  3208. {
  3209.     int m = 0;
  3210.     Obj *rest, *head, *types, *values, *subrest, *subrest2;
  3211.  
  3212.     /* Assume that if the destination array does not exist, there is
  3213.        probably a reason, and it's not our concern. */
  3214.     if (arr == NULL)
  3215.       return;
  3216.     for_all_list(lis, rest) {
  3217.         head = car(rest);
  3218.         if (numberp(head)) {
  3219.         if (m < nummtypes) {
  3220.             arr[m++] = c_number(head);
  3221.         } else {
  3222.         init_warning("too many numbers in list");
  3223.         }
  3224.     } else if (consp(head)) {
  3225.         types = eval(car(head));
  3226.         values = eval(cadr(head));
  3227.         if (mtypep(types)) {
  3228.         m = types->v.num;
  3229.             arr[m++] = c_number(values);
  3230.         } else if (consp(values)) {
  3231.         for_both_lists(types, values, subrest, subrest2) {
  3232.             TYPECHECK(mtypep, car(subrest), "not a material type");
  3233.             m = car(subrest)->v.num;
  3234.             arr[m++] = c_number(car(subrest2));
  3235.         }
  3236.         } else {
  3237.         for_all_list(types, subrest) {
  3238.             TYPECHECK(mtypep, car(subrest), "not a material type");
  3239.             m = car(subrest)->v.num;
  3240.             arr[m++] = c_number(values);
  3241.         }
  3242.         }
  3243.     } else {
  3244.         /* syntax error */
  3245.     }
  3246.     }
  3247. }
  3248.  
  3249. static void
  3250. interp_short_array(arr, lis, n)
  3251. short *arr;
  3252. Obj *lis;
  3253. int n;
  3254. {
  3255.     int i = 0;
  3256.     Obj *rest, *head;
  3257.  
  3258.     /* Assume that if the destination array does not exist, there is
  3259.        probably a reason, and it's not our concern. */
  3260.     if (arr == NULL)
  3261.       return;
  3262.     for_all_list(lis, rest) {
  3263.         head = car(rest);
  3264.         if (numberp(head)) {
  3265.         if (i < n) {
  3266.             arr[i++] = c_number(head);
  3267.         } else {
  3268.         init_warning("too many numbers in list");
  3269.         break;
  3270.         }
  3271.     }
  3272.     }
  3273. }
  3274.  
  3275. static void
  3276. interp_long_array(arr, lis, n)
  3277. long *arr;
  3278. Obj *lis;
  3279. int n;
  3280. {
  3281.     int i = 0;
  3282.     Obj *rest, *head;
  3283.  
  3284.     /* Assume that if the destination array does not exist, there is
  3285.        probably a reason, and it's not our concern. */
  3286.     if (arr == NULL)
  3287.       return;
  3288.     for_all_list(lis, rest) {
  3289.         head = car(rest);
  3290.         if (numberp(head)) {
  3291.         if (i < n) {
  3292.             arr[i++] = c_number(head);
  3293.         } else {
  3294.         init_warning("too many numbers in list");
  3295.         break;
  3296.         }
  3297.     }
  3298.     }
  3299. }
  3300.  
  3301. /* Interpret a unit's action state. */
  3302.  
  3303. static void
  3304. interp_unit_act(unit, props)
  3305. Unit *unit;
  3306. Obj *props;
  3307. {
  3308.     int numval;
  3309.     Obj *bdg, *propval;
  3310.     char *propname;
  3311.  
  3312.     if (unit->act == NULL) {
  3313.     unit->act = (ActorState *) xmalloc(sizeof(ActorState));
  3314.     /* Flag the action as undefined. */
  3315.     unit->act->nextaction.type = ACTION_NONE;
  3316.     }
  3317.     for (; props != lispnil; props = cdr(props)) {
  3318.     bdg = car(props);
  3319.     PARSE_PROPERTY(bdg, propname, propval);
  3320.     if (numberp(propval))
  3321.       numval = c_number(propval);
  3322.     switch (keyword_code(propname)) {
  3323.       case K_ACP:
  3324.         unit->act->acp = numval;
  3325.         break;
  3326.       case K_ACP0:
  3327.         unit->act->initacp = numval;
  3328.         break;
  3329.       case K_AA:
  3330.         unit->act->actualactions = numval;
  3331.         break;
  3332.       case K_AM:
  3333.         unit->act->actualmoves = numval;
  3334.         break;
  3335.       case K_A:
  3336.         /* (should interp a spec for the next action) */
  3337.         break;
  3338.       default:
  3339.         unknown_property("unit actionstate", unit_desig(unit), propname);
  3340.     }
  3341.     }
  3342. }
  3343.  
  3344. /* Fill in a unit's plan. */
  3345.  
  3346. static void
  3347. interp_unit_plan(unit, props)
  3348. Unit *unit;
  3349. Obj *props;
  3350. {
  3351.     int numval;
  3352.     Obj *bdg, *propval, *plantypesym, *trest;
  3353.     char *propname;
  3354.     Goal *goal;
  3355.     Task *task;
  3356.  
  3357.     if (unit->plan == NULL) {
  3358.     /* Create the plan explicitly, even if unit type doesn't allow it
  3359.        (type might be changed later in the reading process). */
  3360.     unit->plan = (Plan *) xmalloc(sizeof(Plan));
  3361.     /* From init_unit_plan: can't call it directly, might not behave
  3362.        right (should fix to be callable from here - problem is that
  3363.        other unit props such as cp might not be set right yet) */
  3364.     /* Allow AIs to make this unit do things. */
  3365.     unit->plan->aicontrol = TRUE;
  3366.     /* Enable supply alarms by default. */
  3367.     unit->plan->supply_alarm = TRUE;
  3368.     }
  3369.     plantypesym = car(props);
  3370.     SYNTAX(props, symbolp(plantypesym), "plan type must be a symbol");
  3371.     unit->plan->type = lookup_plan_type(c_string(plantypesym));
  3372.     props = cdr(props);
  3373.     SYNTAX(props, numberp(car(props)), "plan creation turn must be a number");
  3374.     unit->plan->creation_turn = c_number(car(props));
  3375.     props = cdr(props);
  3376.     for (; props != lispnil; props = cdr(props)) {
  3377.     bdg = car(props);
  3378.     PARSE_PROPERTY(bdg, propname, propval);
  3379.     if (numberp(propval))
  3380.       numval = c_number(propval);
  3381.     switch (keyword_code(propname)) {
  3382.       case K_INITIAL_TURN:
  3383.         unit->plan->initial_turn = numval;
  3384.         break;
  3385.       case K_FINAL_TURN:
  3386.         unit->plan->final_turn = numval;
  3387.         break;
  3388.       case K_ASLEEP:
  3389.         unit->plan->asleep = numval;
  3390.         break;
  3391.       case K_RESERVE:
  3392.         unit->plan->reserve = numval;
  3393.         break;
  3394.       case K_DELAYED:
  3395.         unit->plan->delayed = numval;
  3396.         break;
  3397.       case K_WAIT:
  3398.         unit->plan->waitingfortasks = numval;
  3399.         break;
  3400.       case K_AI_CONTROL:
  3401.         unit->plan->aicontrol = numval;
  3402.         break;
  3403.       case K_SUPPLY_ALARM:
  3404.         unit->plan->supply_alarm = numval;
  3405.         break;
  3406.       case K_SUPPLY_IS_LOW:
  3407.         unit->plan->supply_is_low = numval;
  3408.         break;
  3409.       case K_WAIT_TRANSPORT:
  3410.         unit->plan->waitingfortransport = numval;
  3411.         break;
  3412.       case K_GOAL:
  3413.         goal = interp_goal(cdr(bdg));
  3414.         unit->plan->maingoal = goal;
  3415.         break;
  3416.       case K_FORMATION:
  3417.         goal = interp_goal(cdr(bdg));
  3418.         unit->plan->formation = goal;
  3419.         /* (should do after all units read in!) */
  3420.         unit->plan->funit = find_unit(goal->args[0]);
  3421.         break;
  3422.       case K_TASKS:
  3423.         for_all_list(cdr(bdg), trest) {
  3424.             task = interp_task(car(trest));
  3425.         if (task) {
  3426.             /* (should add tasks in reverse order) */
  3427.             task->next = unit->plan->tasks;
  3428.             unit->plan->tasks = task;
  3429.         }
  3430.         }
  3431.         break;
  3432.       default:
  3433.         unknown_property("unit plan", unit_desig(unit), propname);
  3434.     }
  3435.     }
  3436. }
  3437.  
  3438. int
  3439. lookup_plan_type(name)
  3440. char *name;
  3441. {
  3442.     int i;
  3443.     extern char *plantypenames[];
  3444.  
  3445.     for (i = 0; plantypenames[i] != NULL; ++i)
  3446.       /* should get real enum */
  3447.       if (strcmp(name, plantypenames[i]) == 0)
  3448.     return i;
  3449.     return PLAN_NONE;
  3450. }
  3451.  
  3452. static Task *
  3453. interp_task(form)
  3454. Obj *form;
  3455. {
  3456.     int tasktype, numargs, i;
  3457.     char *argtypes;
  3458.     Obj *tasktypesym;
  3459.     Task *task;
  3460.  
  3461.     tasktypesym = car(form);
  3462.     SYNTAX_RETURN(form, symbolp(tasktypesym), "task type must be a symbol", NULL);
  3463.     tasktype = lookup_task_type(c_string(tasktypesym));
  3464.     task = create_task(tasktype);
  3465.     form = cdr(form);
  3466.     task->execnum = c_number(car(form));
  3467.     form = cdr(form);
  3468.     task->retrynum = c_number(car(form));
  3469.     form = cdr(form);
  3470.     argtypes = taskdefns[tasktype].argtypes;
  3471.     numargs = strlen(argtypes);
  3472.     for (i = 0; i < numargs; ++i) {
  3473.     if (form == lispnil)
  3474.       break;
  3475.     SYNTAX_RETURN(form, numberp(car(form)), "task arg must be a number", NULL);
  3476.     task->args[i] = c_number(car(form));
  3477.     form = cdr(form);
  3478.     }
  3479.     /* Warn about unused data, but not a serious problem. */
  3480.     if (form != lispnil)
  3481.       read_warning("Excess args for task %s", task_desig(task));
  3482.     return task;
  3483. }
  3484.  
  3485. static Goal *
  3486. interp_goal(form)
  3487. Obj *form;
  3488. {
  3489.     int goaltype, tf, numargs, i;
  3490.     char *argtypes;
  3491.     Obj *goaltypesym;
  3492.     Goal *goal;
  3493.     Side *side;
  3494.  
  3495.     SYNTAX_RETURN(form, numberp(car(form)), "goal side must be a number", NULL);
  3496.     side = side_n(c_number(car(form)));
  3497.     form = cdr(form);
  3498.     SYNTAX_RETURN(form, numberp(car(form)), "goal tf must be a number", NULL);
  3499.     tf = c_number(car(form));
  3500.     form = cdr(form);
  3501.     goaltypesym = car(form);
  3502.     SYNTAX_RETURN(form, symbolp(goaltypesym), "goal type must be a symbol", NULL);
  3503.     goaltype = lookup_goal_type(c_string(goaltypesym));
  3504.     goal = create_goal(goaltype, side, tf);
  3505.     form = cdr(form);
  3506.     argtypes = goaldefns[goaltype].argtypes;
  3507.     numargs = strlen(argtypes);
  3508.     for (i = 0; i < numargs; ++i) {
  3509.     if (form == lispnil)
  3510.       break;
  3511.     SYNTAX_RETURN(form, numberp(car(form)), "goal arg must be a number", NULL);
  3512.     goal->args[i] = c_number(car(form));
  3513.     form = cdr(form);
  3514.     }
  3515.     /* Warn about unused data, but not a serious problem. */
  3516.     if (form != lispnil)
  3517.       read_warning("Excess args for goal %s", goal_desig(goal));
  3518.     return goal;
  3519. }
  3520.  
  3521. /* (to goal.c?) */
  3522.  
  3523. int
  3524. lookup_goal_type(name)
  3525. char *name;
  3526. {
  3527.     int i;
  3528.  
  3529.     for (i = 0; goaldefns[i].name != NULL; ++i)
  3530.       if (strcmp(name, goaldefns[i].name) == 0)
  3531.     return i; /* should get real enum? */
  3532.     return GOAL_NO;
  3533. }
  3534.  
  3535. /* Make a namer from the form. */
  3536.  
  3537. static void
  3538. interp_namer(form)
  3539. Obj *form;
  3540. {
  3541.     Obj *id = cadr(form), *meth = car(cddr(form));
  3542.  
  3543.     if (symbolp(id)) {
  3544.     setq(id, make_namer(id, meth));
  3545.     }
  3546. }
  3547.  
  3548. static void
  3549. interp_text_generator(form)
  3550. Obj *form;
  3551. {
  3552.     Obj *id = cadr(form);
  3553.  
  3554.     if (symbolp(id)) {
  3555.     setq(id, lispnil);
  3556.     }
  3557. }
  3558.  
  3559. /* Make a scorekeeper from the given form. */
  3560.  
  3561. static void
  3562. interp_scorekeeper(form)
  3563. Obj *form;
  3564. {
  3565.     int id = 0;
  3566.     char *propname;
  3567.     Obj *props = cdr(form), *bdg, *propval;
  3568.     Scorekeeper *sk = NULL;
  3569.  
  3570.     if (numberp(car(props))) {
  3571.     id = c_number(car(props));
  3572.     props = cdr(props);
  3573.     }
  3574.     if (id > 0) {
  3575.     sk = find_scorekeeper(id);
  3576.     }
  3577.     /* Create a new scorekeeper object if necessary. */
  3578.     if (sk == NULL) {
  3579.     sk = create_scorekeeper();
  3580.     if (id > 0) {
  3581.         sk->id = id;
  3582.     }
  3583.     }
  3584.     /* Interpret the properties. */
  3585.     for (; props != lispnil; props = cdr(props)) {
  3586.     bdg = car(props);
  3587.     PARSE_PROPERTY(bdg, propname, propval);
  3588.     switch (keyword_code(propname)) {
  3589.       case K_TITLE:
  3590.         sk->title = c_string(propval);
  3591.         break;
  3592.       case K_WHEN:
  3593.         sk->when = propval;
  3594.         break;
  3595.       case K_APPLIES_TO:
  3596.         sk->who = propval;
  3597.         break;
  3598.       case K_KNOWN_TO:
  3599.         sk->knownto = propval;
  3600.         break;
  3601.       case K_TRIGGER:
  3602.         sk->trigger = propval;
  3603.         break;
  3604.       case K_DO:
  3605.         sk->body = propval;
  3606.         break;
  3607.       case K_MESSAGES:
  3608.         sk->messages = propval;
  3609.         break;
  3610.       case K_TRIGGERED:
  3611.         sk->triggered = c_number(propval);
  3612.         break;
  3613.       case K_INITIAL:
  3614.         sk->initial = c_number(propval);
  3615.         break;
  3616.       case K_NOTES:
  3617.         sk->notes = propval;
  3618.         break;
  3619.       default:
  3620.         unknown_property("scorekeeper", "??", propname);
  3621.     }
  3622.     }
  3623. }
  3624.  
  3625. /* Make a past unit from the form. */
  3626.  
  3627. static void
  3628. interp_past_unit(form)
  3629. Obj *form;
  3630. {
  3631.     int u = NONUTYPE, nid;
  3632.     char *propname;
  3633.     Obj *props, *bdg, *propval;
  3634.     PastUnit *pastunit;
  3635.  
  3636.     Dprintf("Reading a past unit from ");
  3637.     Dprintlisp(form);
  3638.     Dprintf("\n");
  3639.     props = cdr(form);
  3640.     if (numberp(car(props))) {
  3641.     nid = c_number(car(props));
  3642.     props = cdr(props);
  3643.     } else {
  3644.     /* (should be error) */
  3645.     }
  3646.     if (symbolp(car(props))) {
  3647.     u = utype_from_symbol(car(props));
  3648.     props = cdr(props);
  3649.     }
  3650.     if (u == NONUTYPE) {
  3651.     read_warning("bad exu");
  3652.     return;
  3653.     }
  3654.     pastunit = create_past_unit(u, nid);
  3655.     /* Peel off fixed-position properties, if they're supplied. */
  3656.     if (numberp(car(props))) {
  3657.     pastunit->x = c_number(eval(car(props)));
  3658.     props = cdr(props);
  3659.     }
  3660.     if (numberp(car(props))) {
  3661.     pastunit->y = c_number(eval(car(props)));
  3662.     props = cdr(props);
  3663.     }
  3664.     if (!consp(car(props))) {
  3665.     pastunit->side = side_n(c_number(eval(car(props))));
  3666.     props = cdr(props);
  3667.     }
  3668.     for (; props != lispnil; props = cdr(props)) {
  3669.     bdg = car(props);
  3670.     PARSE_PROPERTY(bdg, propname, propval);
  3671.     switch (keyword_code(propname)) {
  3672.       case K_Z:
  3673.         pastunit->z = c_number(propval);
  3674.         break;
  3675.       case K_N:
  3676.         pastunit->name = c_string(propval);
  3677.         break;
  3678.       case K_NB:
  3679.         pastunit->number = c_number(propval);
  3680.         break;
  3681.       default:
  3682.         unknown_property("exu", "??", propname);
  3683.     }
  3684.     }
  3685. }
  3686.  
  3687. /* Make a historical event from the form. */
  3688.  
  3689. static void
  3690. interp_history(form)
  3691. Obj *form;
  3692. {
  3693.     int startdate, type, i;
  3694.     char *typename;
  3695.     SideMask observers;
  3696.     Obj *props;
  3697.     HistEvent *hevt;
  3698.  
  3699.     Dprintf("Reading a hist event from ");
  3700.     Dprintlisp(form);
  3701.     Dprintf("\n");
  3702.     props = cdr(form);
  3703.     /* Get the event's date. */
  3704.     if (numberp(car(props))) {
  3705.     startdate = c_number(car(props));
  3706.     props = cdr(props);
  3707.     } else {
  3708.     syntax_error(form, "bad hevt date");
  3709.     return;
  3710.     }
  3711.     /* Get the event type. */
  3712.     if (symbolp(car(props))) {
  3713.     typename = c_string(car(props));
  3714.     type = -1;
  3715.     for (i = 0; hevtdefns[i].name != NULL; ++i)
  3716.       if (strcmp(typename, hevtdefns[i].name) == 0) {
  3717.           type = i;
  3718.           break;
  3719.       }
  3720.     props = cdr(props);
  3721.     } else {
  3722.     syntax_error(form, "bad hevt type");
  3723.     return;
  3724.     }
  3725.     /* Get the bit vector of observers. */
  3726.     if (numberp(car(props))) {
  3727.     observers = c_number(car(props));
  3728.     props = cdr(props);
  3729.     } else if (symbolp(car(props))
  3730.            && keyword_code(c_string(car(props))) == K_ALL) {
  3731.     observers = ALLSIDES;
  3732.     props = cdr(props);
  3733.     } else {
  3734.     syntax_error(form, "bad hevt observers");
  3735.     return;
  3736.     }
  3737.     hevt = create_historical_event(type);
  3738.     hevt->startdate = startdate;
  3739.     hevt->observers = observers;
  3740.     /* Read up to 4 remaining numbers. */
  3741.     i = 0;
  3742.     for (; props != lispnil && i < 4; props = cdr(props)) {
  3743.     hevt->data[i++] = c_number(car(props));
  3744.     }
  3745.     /* Insert the newly created event. */
  3746.     /* (linking code should be in its own routine) */
  3747.     hevt->next = history;
  3748.     hevt->prev = history->prev;
  3749.     history->prev->next = hevt;
  3750.     history->prev = hevt;
  3751. }
  3752.  
  3753. /* Designer is trying to define too many different types. */
  3754.  
  3755. static void
  3756. too_many_types(typename, maxnum, name)
  3757. char *typename;
  3758. int maxnum;
  3759. Obj *name;
  3760. {
  3761.     read_warning("Limited to %d types of %s", maxnum, typename);
  3762.     sprintlisp(spbuf, name);
  3763.     read_warning("(Failed to create type with name `%s')", spbuf);
  3764. }
  3765.  
  3766. /* Property name is unknown, either misspelled or misapplied. */
  3767.  
  3768. static void
  3769. unknown_property(type, inst, name)
  3770. char *type, *inst, *name;
  3771. {
  3772.     read_warning("The %s form %s has no property named %s", type, inst, name);
  3773. }
  3774.  
  3775. static void
  3776. read_layer(contents, setter)
  3777. Obj *contents;
  3778. void (*setter) PARAMS ((int, int, int));
  3779. {
  3780.     int i, slen, n, ix, len, usechartable = FALSE;
  3781.     char *str;
  3782.     short chartable[256];
  3783.     Obj *rest, *desc, *rest2, *subdesc, *sym, *num;
  3784.  
  3785.     layer_use_default = FALSE;
  3786.     layer_default = 0;
  3787.     layer_multiplier = 1;
  3788.     layer_adder = 0;
  3789.     layer_area_x = area.fullx;  layer_area_y = area.fully;
  3790.     layer_area_w = area.width;  layer_area_h = area.height;
  3791.     if (area.fullwidth > 0)
  3792.       layer_area_w = area.fullwidth;
  3793.     if (area.fullheight > 0)
  3794.       layer_area_h = area.fullheight;
  3795.     ignore_specials = FALSE;
  3796.     for_all_list(contents, rest) {
  3797.     desc = car(rest);
  3798.     if (stringp(desc)) {
  3799.         /* Read from here to the end of the list, interpreting as
  3800.            contents. */
  3801.         read_rle(rest, setter, (usechartable ? chartable : NULL));
  3802.         return;
  3803.     } else if (consp(desc) && symbolp(car(desc))) {
  3804.         switch (keyword_code(c_string(car(desc)))) {
  3805.           case K_CONSTANT:
  3806.         /* should set to a constant value taken from cadr */
  3807.         read_warning("Constant layers not supported yet");
  3808.         return;
  3809.           case K_SUBAREA:
  3810.             /* should apply data to a subarea */
  3811.         read_warning("Layer subareas not supported yet");
  3812.         break;
  3813.           case K_XFORM:
  3814.         layer_multiplier = c_number(cadr(desc));
  3815.         layer_adder = c_number(caddr(desc));
  3816.         break;
  3817.           case K_BY_BITS:
  3818.         break;
  3819.           case K_BY_CHAR:
  3820.         /* Assign each char to its corresponding index. */
  3821.         /* First seed the table with a 1-1 map. */
  3822.         for (i = 0; i < 255; ++i)
  3823.           chartable[i] = 0;
  3824.         for (i = 'a'; i <= '~'; ++i)
  3825.           chartable[i] = i - 'a';
  3826.         for (i = ':'; i <= '['; ++i)
  3827.           chartable[i] = i - ':' + 30;
  3828.         str = c_string(cadr(desc));
  3829.         len = strlen(str);
  3830.         for (i = 0; i < len; ++i) {
  3831.             chartable[(int) str[i]] = i;
  3832.             /* If special chars in by-char string, flag it. */
  3833.             if (str[i] == '*' || str[i] == ',')
  3834.               ignore_specials = TRUE;
  3835.         }
  3836.         usechartable = TRUE;
  3837.         break;
  3838.           case K_BY_NAME:
  3839.         /* Work through list and match names to numbers. */
  3840.         /* First seed the table with a 1-1 map. */
  3841.         for (i = 0; i < 255; ++i)
  3842.           chartable[i] = 0;
  3843.         for (i = 'a'; i <= '~'; ++i)
  3844.           chartable[i] = i - 'a';
  3845.         for (i = ':'; i <= '['; ++i)
  3846.           chartable[i] = i - ':' + 30;
  3847.         desc = cdr(desc);
  3848.         /* Support optional explicit string a la by-char. */
  3849.         if (stringp(car(desc))) {
  3850.             str = c_string(car(desc));
  3851.             slen = strlen(str);
  3852.             for (i = 0; i < slen; ++i)
  3853.               chartable[(int) str[i]] = i;
  3854.             desc = cdr(desc);
  3855.         } else {
  3856.             str = NULL;
  3857.         }
  3858.         i = 0;
  3859.         for (rest2 = desc; rest2 != lispnil; rest2 = cdr(rest2)) {
  3860.             subdesc = car(rest2);
  3861.             if (symbolp(subdesc)) {
  3862.                 sym = subdesc;
  3863.                 ix = i++;
  3864.             } else if (consp(subdesc)) {
  3865.                 sym = car(subdesc);
  3866.                 num = cadr(subdesc);
  3867.                 TYPECHECK(numberp, num,
  3868.                   "by-name explicit value is not a number");
  3869.                 ix = c_number(num);
  3870.             } else {
  3871.                 read_warning("garbage by-name subdesc, ignoring");
  3872.                 continue;
  3873.             }
  3874.             /* Eval the symbol into something resembling a value. */
  3875.             sym = eval(sym);
  3876.             TYPECHECK(numberishp, sym,
  3877.                   "by-name index is not a number or type");
  3878.             n = c_number(sym);
  3879.             chartable[(str ? str[ix] : (ix <= 29 ? ('a' + ix) : (':' + ix - 30)))] = n;
  3880.         }
  3881.         usechartable = TRUE;
  3882.         break;
  3883.           default:
  3884.         sprintlisp(readerrbuf, desc);
  3885.         read_warning("Ignoring garbage terrain description %s",
  3886.                  readerrbuf);
  3887.         }
  3888.     }
  3889.     }
  3890. }
  3891.  
  3892. /* General RLE reader.  This basically parses the run lengths and calls
  3893.    the function that records what was read. */
  3894.  
  3895. static void
  3896. read_rle(contents, setter, chartable)
  3897. Obj *contents;
  3898. void (*setter) PARAMS ((int, int, int));
  3899. short *chartable;
  3900. {
  3901.     char ch, *rowstr;
  3902.     int i, x, y, run, val, sawval, sawneg, sgn, x1, y1, numbadchars = 0;
  3903.     Obj *rest;
  3904.  
  3905.     rest = contents;
  3906.     y = layer_area_h - 1;
  3907.     while (rest != lispnil && y >= 0) {
  3908.     /* should error check ... */
  3909.     rowstr = c_string(car(rest));
  3910.     i = 0;
  3911.     x = 0;  /* depends on shape of saved data... */
  3912.     while ((ch = rowstr[i++]) != '\0' && x < layer_area_w) {
  3913.         sawval = FALSE;
  3914.         sawneg = FALSE;
  3915.         if (isdigit(ch) || ch == '-') {
  3916.         if (ch == '-') {
  3917.             sawneg = TRUE;
  3918.             ch = rowstr[i++];
  3919.             /* A minus sign by itself is a problem. */
  3920.             if (!isdigit(ch))
  3921.               goto recovery;
  3922.         }
  3923.         /* Interpret a substring of digits as a run length. */
  3924.         run = ch - '0';
  3925.         while ((ch = rowstr[i++]) != 0 && isdigit(ch)) {
  3926.             run = run * 10 + ch - '0';
  3927.         }
  3928.         /* A '*' separates a run and a numeric value. */
  3929.         if (ch == '*' && !ignore_specials) {
  3930.             /* A negative run length is a problem. */
  3931.             if (sawneg)
  3932.               goto recovery;
  3933.             ch = rowstr[i++];
  3934.             /* If we're seeing garbled data, skip to the next line. */
  3935.             if (ch == '\0')
  3936.               goto recovery;
  3937.             /* Recognize a negative number. */
  3938.             sgn = 1;
  3939.             if (ch == '-') {
  3940.             val = -1;
  3941.             ch = rowstr[i++];
  3942.             }
  3943.             /* Interpret these digits as a value. */
  3944.             if (isdigit(ch)) {
  3945.             val = ch - '0';
  3946.             while ((ch = rowstr[i++]) != 0 && isdigit(ch)) {
  3947.                 val = val * 10 + ch - '0';
  3948.             }
  3949.             sawval = TRUE;
  3950.             val = sgn * val;
  3951.             } else {
  3952.             /* Some other char seen - just ignore the '*' then. */
  3953.             }
  3954.             /* If we're seeing garbled data, skip to the next line. */
  3955.             if (ch == '\0')
  3956.               goto recovery;
  3957.         }
  3958.         /* If we're seeing garbled data, skip to the next line. */
  3959.         if (ch == '\0')
  3960.           goto recovery;
  3961.         } else {
  3962.         run = 1;
  3963.         }
  3964.         if (ch == ',' && !ignore_specials) {
  3965.             if (!sawval) {
  3966.             /* This was a value instead of a run length. */
  3967.             val = run;
  3968.             /* If it was prefixed with a minus sign originally,
  3969.                negate the value. */
  3970.             if (sawneg)
  3971.               val = - val;
  3972.             run = 1;
  3973.         } else {
  3974.             /* Comma is just being a separator. */
  3975.         }
  3976.         } else if (chartable != NULL) {
  3977.         val = chartable[ch];
  3978.         } else if (between('a', ch, '~')) {
  3979.         val = ch - 'a';
  3980.         } else if (between(':', ch, '[')) {
  3981.         val = ch - ':' + 30;
  3982.         } else {
  3983.             /* Warn about strange characters. */
  3984.         ++numbadchars;
  3985.         if (numbadchars <= 5) {
  3986.             read_warning(
  3987.              "Bad char '%c' (0x%x) in layer, using NUL instead",
  3988.                  ch, ch);
  3989.             /* Clarify that we're not going to report all bad chars. */
  3990.             if (numbadchars == 5)
  3991.               read_warning(
  3992.              "Additional bad chars will not be reported individually");
  3993.         }
  3994.         val = 0;
  3995.         }
  3996.         val = val * layer_multiplier + layer_adder;
  3997.         /* Given a run of values, stuff them into the layer. */
  3998.         while (run-- > 0) {
  3999.             x1 = wrapx(x - layer_area_x);  y1 = y - layer_area_y;
  4000.             if (in_area(x1, y1))
  4001.           (*setter)(x1, y1, val);
  4002.         ++x;
  4003.         }
  4004.     }
  4005.       recovery:
  4006.     /* Fill-in string may be too short for this row; just leave
  4007.        the rest of it alone, assume that somebody has assured
  4008.        that the contents are reasonable. */
  4009.     rest = cdr(rest);
  4010.     y--;
  4011.     }
  4012.     /* Report the count of garbage chars, in case there were a great many. */
  4013.     if (numbadchars > 0)
  4014.       init_warning("A total of %d bad chars were present", numbadchars);
  4015. }
  4016.